home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Education / PC-SiG's World of Education.iso / run / 0707 / curve225.bas < prev    next >
Encoding:
BASIC Source File  |  1992-05-08  |  62.6 KB  |  1,047 lines
  1. 3 KEY OFF  'REM 2.25a corrects bugs in Data Del and Add routines of 2.25
  2. 5 DEFEXT A,B,C,S,R,X,Y,V:MONITOR2$="Y":cp$="##.####^^^"
  3. 6 DIM EQ$(25),RS(25),RS1$(25),RS$(25):gosub 55000
  4. 7 DIM X1$(999),Y1$(999),X$(999),Y$(999),X(999),Y(999),R(65),RR(25)
  5. 8 DIM RC(25),A(25),B(25),C(25):FOR I=1 TO 999:X$(I)="END":Y$(I)="END":NEXT I
  6. 9 CLS:COLOR 7,0,0:PR$="░░░░░░░░░░":goto 36000
  7. 10 CLS:GOSUB 38000:PRINT"╔═══════════╦══════════════════════════════════════════════════════╦══════════╗";
  8. 11 PRINT"║ CURVEFIT  ║ Version 2.25a  MAY  09, 1992       by  Thomas S. Cox ║SHAREWARE ║";
  9. 12 PRINT"╠═══════════╩══════════════════════════════════════════════════════╩══════════╣";
  10. 13 PRINT"║ PURPOSE     This program performs a least squares curve fit on X, Y data.   ║";
  11. 14 PRINT"║             Curves for 25 equations are fitted.  Equation coefficients,     ║";
  12. 15 PRINT"║             Correlation Coefficient, and Best Fit are computed.  For any    ║";
  13. 16 PRINT"║             of the 25 equations, predictions for Y can be calculated.       ║";
  14. 17 PRINT"║                                                                             ║";
  15. 18 PRINT"║ REFERENCE   CURVE FITTING FOR PROGRAMMABLE CALCULATORS by William M. Kolb   ║";
  16. 19 PRINT"║             Published by: IMTEC  P. O. Box 1402  Bowie MD  20716            ║";
  17. 20 PRINT"║                                                                             ║";
  18. 21 PRINT"║ WARNING     A LINEARIZING  technique is applied to various equations so that║";
  19. 22 PRINT"║ and         the resulting equations are of the general form: Y=A+B*X        ║";
  20. 23 PRINT"║ DISCLAIMER  This means that sum of squares of errors in Y are not minimized,║";
  21. 24 PRINT"║             but the sum of squares of the linearized variable are minimized.║";
  22. 25 PRINT"║                                                                             ║";
  23. 26 PRINT"║             The Linear, Parabolic, Cubic and Hyperbolic equations are linear║";
  24. 27 PRINT"║             in the parameters so this reservation does not apply to those   ║";
  25. 28 PRINT"║             curves. Reservation applies to equations with LN, EXP or POWERS.║";
  26. 29 PRINT"║                                                                             ║";
  27. 30 PRINT"║ SHAREWARE   If you use and like this program a donation of $10 is requested.║";
  28. 31 PRINT"╚═════════════════════════════════════════════════════════════════════════════╝";
  29. 32 PRINT TAB(2);:INPUT"PRESS <ENTER> TO START PROGRAM EXECUTION";A$
  30. 33 CLS:GOSUB 38000:XQ=0
  31. 110 IF XQ >0 THEN 1000 ELSE 115
  32. 115 CLS:GOSUB 38000:XQ=1
  33. 120 CLS:Q1$="N":GOSUB 38000:PRINT "╔═══════════╦══════════════════════════════════════════════════════╦══════════╗";
  34. 130 PRINT "║ CURVEFIT  ║  Version 2.25a   MAY  09, 1992    by  Thomas S. Cox  ║SHAREWARE ║";
  35. 131 PRINT "╠═══════════╩══════════╤═══════════════════════════════════════════╩══════════╣";
  36. 132 PRINT "║ POWER BASIC VERS 2.1 │          M  A  S  T  E  R     M  E  N  U             ║";
  37. 134 PRINT "╠═══════════╦══════════╪══════════════════════════════════════════════════════╣";
  38. 135 PRINT "║  SELECT   ║ CHOICES  │ BRIEF DESCRIPTION OF CHOICES                         ║";
  39. 140 PRINT "╠═══════════╬══════════╪══════════════════════════════════════════════════════╣";
  40. 150 PRINT "║      F1[ ]║ KEYBD DAT│ New Data (X and Y values) Entered from Keyboard      ║";
  41. 160 PRINT "║      F2[ ]║ DISK DATA│ Load From Disk a Previously Stored Data File         ║";
  42. 170 PRINT "║      F3[ ]║  ADD DATA│ Add Additional X,Y Data to Data Already in Memory    ║";
  43. 180 PRINT "║      F4[ ]║  DEL DATA│ or CHANGE Values of X and Y Currently in Memory      ║";
  44. 190 PRINT "║      F5[ ]║ LIST DATA│ X and Y Values Currently in Memory                   ║";
  45. 200 PRINT "║      F6[ ]║ CALC COEF│ Equation Coefficients (A, B, C, and R^2)             ║";
  46. 210 PRINT "║      F7[ ]║ RESIDUALS│ For Input Values of X, Y and Eq# (1-25) Show Residual║";
  47. 220 PRINT "║      F8[ ]║ VIEW EQTS│ LIST of EQUATIONS Fitted Using this Program          ║";
  48. 230 PRINT "║      F9[ ]║ VIEW COEF│ Equation Coefficients (A, B, C, R^2)                 ║";
  49. 240 PRINT "║     F10[ ]║ PREDICT Y│ For any Equation, Enter Range of X to see Predicted Y║";
  50. 250 PRINT "║ SHFT F1[ ]║ SAVE DATA│ X and Y Data Points to a DISK FILE                   ║";
  51. 260 PRINT "║ SHFT F2[ ]║ SUM OF SQ│ Display or Print SUMS and SUMS of SQUARES for REGRESS║";
  52. 261 PRINT "║ SHFT F3[ ]║  BEST FIT│ Sorted by R² (Coefficients MUST have been calculated)║";
  53. 265 PRINT "║ SHFT F4[ ]║ COLR/MONO│ Select COLOR or MONOCHROME (Default is COLOR + HERC) ║";
  54. 270 PRINT "╠═══════════╩══════════╧══════════════════════════════════════════════════════╣";
  55. 274 PRINT "║ Use UP or DOWN Keys to Select, Press ENTER; or FUNCTION KEY.  <ESC> to EXIT ║";
  56. 280 PRINT "╚═════════════════════════════════════════════════════════════════════════════╝";
  57. 284 LP=0 :LOCATE 25,1:COLOR 0,7,0:PRINT " Last Active File Used by CURVEFIT Was:  ";LEFT$(A4$,30);:GOSUB 38000
  58. 285 D1=8:GOTO 63500
  59. 1000 CLS: GOSUB 38000:PRINT "DATA ENTRY ROUTINE": PRINT " "
  60. 1001 INPUT"This routine will overwrite any existing data.  OK to proceed (Y) or (N)";A1$
  61. 1002 IF LEFT$(A1$,1)="Y" OR LEFT$(A1$,1)="y" THEN 1006
  62. 1003 IF LEFT$(A1$,1)="N" OR LEFT$(A1$,1)="n" THEN 120
  63. 1004 GOTO 120
  64. 1006 FOR I=1 TO 999:X$(I)="END":Y$(I)="END":NEXT I:PRINT"ALL VALUES HAVE BEEN SET TO ZERO"
  65. 1007 FOR I=1 TO 25:A(I)=0:B(I)=0:C(I)=0:R(I)=0:RR(I)=0:NEXT I
  66. 1008 INPUT "Do you want to have INPUT data listed on printer (Y or N)";Q1$
  67. 1009 GOSUB 50000:CLS:GOSUB 38000:M=1
  68. 1010 PRINT "Enter (S)top for X or Y to terminate data entry."
  69. 1011 CLS:GOSUB 38000:M=1:MR=1:MC=1
  70. 1012 PRINT "╔═══════════╦═══════════════════════════════════════════════════════╦═════════╗"
  71. 1013 PRINT "║ CURVEFIT  ║  Version 2.25a   MAY  09, 1992      by Thomas S. Cox  ║SHAREWARE║"
  72. 1014 PRINT "╠═══════════╩═══════════════════════════════════════════════════════╩═════════╣"
  73. 1015 PRINT "║ DATA ENTRY SCREEN|  Press <ESC> at X or Y entry to Terminate Data Entry     ║"
  74. 1016 PRINT "╟───┬──────────┬──────────┬───┬──────────┬──────────┬───┬──────────┬──────────╢"
  75. 1017 PRINT "║PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  ║"
  76. 1018 PRINT "╟───┼──────────┼──────────┼───┼──────────┼──────────┼───┼──────────┼──────────╢"
  77. 1019 FOR I=1 TO 14:PRINT "║   │          │          │   │          │          │   │          │          ║"
  78. 1020 NEXT I
  79. 1033 PRINT "╠═══╧════════╦═╧═════════╦╧═══╧══╦═══════╧═════╦════╧══╦╧══════════╧══════════╣"
  80. 1034 PRINT "║ ENTER DATA ║PT #       ║X VALUE║             ║Y VALUE║                      ║"
  81. 1035 PRINT "╚════════════╩═══════════╩═══════╩═════════════╩═══════╩══════════════════════╝";
  82. 1036 FOR J=1 TO 999
  83. 1037 LOCATE 7+MR,MC+1:PRINT LEFT$(PR$,3);:LOCATE 7+MR,MC+5:PRINT PR$;:LOCATE 7+MR,MC+16:PRINT PR$;
  84. 1038 LOCATE 23,21:PRINT "     ";:LOCATE 23,21:PRINT USING "####";M;
  85. 1040 LOCATE 23,36:PRINT"░░░░░░░░░░░ ";:LOCATE 23,36,1,0,7:GOSUB 1900:IF I$=CHR$(27) OR I$="S" OR I$="s" THEN 120 else IF I$=CHR$(13) THEN 1042
  86. 1041 PRINT I$;:INPUT "",X$(M):X$(M)=I$+X$(M):LOCATE 23,36:PRINT"           ";:LOCATE 23,36:PRINT" "+X$(M);:GOTO 1044
  87. 1042 INC=1:IF M>2 THEN GOSUB 1910
  88. 1043 V=VAL(X$(M-1)):V=V+INC:X$(M)=STR$(V):LOCATE 23,36:PRINT"            ";:LOCATE 23,36:PRINT" "+X$(M);
  89. 1044 LOCATE 23,58:PRINT"░░░░░░░░░░░ ";:LOCATE 23,58,1,0,7:GOSUB 1900:IF I$=CHR$(27) OR I$="s" OR I$="S" THEN GOTO 120 ELSE PRINT I$;:INPUT"", Y$(M):Y$(M)=I$+Y$(M):LOCATE 23,58:PRINT"            ";:LOCATE 23,58:PRINT "  "+Y$(M);
  90. 1046 LOCATE 7+MR,MC+1:PRINT USING "###";M;
  91. 1047 IF X$(M)="" THEN X$(M)="DEL"
  92. 1048 IF Y$(M)="" THEN Y$(M)="DEL"
  93. 1049 LOCATE 7+MR,MC+5:V=VAL(X$(M)):IF X$(M)="DEL" THEN PRINT"       DEL"; ELSE GOSUB 4710:PRINT USING C2$;V;
  94. 1050 LOCATE 7+MR,MC+16:V=VAL(Y$(M)):IF Y$(M)="DEL" THEN PRINT"       DEL"; ELSE GOSUB 4710:PRINT USING C2$;V;
  95. 1051 MR=MR+1
  96. 1052 IF M MOD 14=0 THEN MR=1:MC=MC+26
  97. 1053 IF M MOD 42=0 THEN MR=1:MC=1
  98. 1054 IF LEFT$(X$(J),1)="S" OR LEFT$(X$(J),1)="s" OR LEFT$(Y$(M),1)="S" OR LEFT$(Y$(M),1)="s" THEN GOTO 1500
  99. 1075 IF LP=1 THEN LPRINT"X( ";J;" )= ";X$(J);TAB(40);"Y( ";J;" )= ";Y$(J)
  100. 1077 M=M+1
  101. 1080 NEXT J
  102. 1090 GOTO 120
  103. 1500 X$(J)="END":Y$(J)="END":LOCATE 25,1:PRINT"(S)top encountered.  More Data (Y or N).";:INPUT;A$
  104. 1510 IF A$ = "Y" OR A$ = "y" THEN MR=MR-1:LOCATE 25,1:PRINT"                                                    ";:GOTO 1040
  105. 1520 GOTO 4620
  106. 1900 I$=INKEY$:IPD$=I$:IF I$=""THEN 1900 ELSE RETURN
  107. 1910 INC=(VAL(X$(M-1)))-(VAL(X$(M-2))):RETURN
  108. 2000 CLS:GOSUB 38000:PRINT"DATA ADDITION ROUTINE":PRINT" "
  109. 2011 CLS:GOSUB 38000:M=1:MR=1:MC=1:MR2=0
  110. 2012 PRINT "╔═══════════╦═══════════════════════════════════════════════════════╦═════════╗"
  111. 2013 PRINT "║ CURVEFIT  ║  Version 2.25a   MAY  09, 1992      by Thomas S. Cox  ║SHAREWARE║"
  112. 2014 PRINT "╠═══════════╩═══════════════════════════════════════════════════════╩═════════╣"
  113. 2015 PRINT "║ DATA ADDITION| Press <ESC> for X or Y to Terminate Data Entry               ║"
  114. 2016 PRINT "╟───┬──────────┬──────────┬───┬──────────┬──────────┬───┬──────────┬──────────╢"
  115. 2017 PRINT "║PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  ║"
  116. 2018 PRINT "╟───┼──────────┼──────────┼───┼──────────┼──────────┼───┼──────────┼──────────╢"
  117. 2019 FOR I=1 TO 14:PRINT "║   │          │          │   │          │          │   │          │          ║"
  118. 2020 NEXT I
  119. 2033 PRINT "╠═══╧════════╦═╧═════════╦╧═══╧══╦═══════╧═════╦════╧══╦╧══════════╧══════════╣"
  120. 2034 PRINT "║ ENTER DATA ║PT #       ║X VALUE║             ║Y VALUE║                      ║"
  121. 2035 PRINT "╚════════════╩═══════════╩═══════╩═════════════╩═══════╩══════════════════════╝";
  122. 2036 QZ=1:GOSUB 3470:QZ=0:FOR J=1 TO 999: REM This routine shows data to 2 decimal places
  123. 2037 IF X$(M)<>"END" OR Y$(M)<>"END"  THEN 2045
  124. 2038 LOCATE 7+MR,MC+1:PRINT LEFT$(PR$,3);:LOCATE 7+MR,MC+5:PRINT PR$;:LOCATE 7+MR,MC+16:PRINT PR$;
  125. 2040 LOCATE 23,21:PRINT "     ";:LOCATE 23,21:PRINT USING "#####";M;
  126. 2042 LOCATE 23,36:PRINT"░░░░░░░░░░░ ";:LOCATE 23,36,1,0,7:GOSUB 1900:IF IPD$=CHR$(27) OR IPD$="s" OR IPD$="S" THEN GOTO 120 ELSE PRINT IPD$;:INPUT"", X$(M):X$(M)=IPD$+X$(M):LOCATE 23,36:PRINT"            ";:LOCATE 23,36:PRINT "  "+X$(M);
  127. 2044 LOCATE 23,58:PRINT"░░░░░░░░░░░ ";:LOCATE 23,58,1,0,7:GOSUB 1900:IF IPD$=CHR$(27) OR IPD$="s" OR IPD$="S" THEN GOTO 120 ELSE PRINT IPD$;:INPUT"", Y$(M):Y$(M)=IPD$+Y$(M):LOCATE 23,58:PRINT"            ";:LOCATE 23,58:PRINT "  "+Y$(M);
  128. 2045 LOCATE 7+MR,MC+1:PRINT USING "###";M;
  129. 2046 IF X$(M)="" THEN X$(M)="DEL"
  130. 2047 IF Y$(M)="" THEN Y$(M)="DEL"
  131. 2048 LOCATE 7+MR,MC+5:V=VAL(X$(M)):IF X$(M)="DEL" THEN PRINT"       DEL"; ELSE GOSUB 4710:PRINT USING C2$;V;
  132. 2049 LOCATE 7+MR,MC+16:V=VAL(Y$(M)):IF Y$(M)="DEL" THEN PRINT"       DEL"; ELSE GOSUB 4710:PRINT USING C2$;V;
  133. 2050 MR=MR+1
  134. 2052 IF M MOD 14=0 THEN MR=1:MC=MC+26
  135. 2053 IF M MOD 42=0 THEN MR=1:MC=1:GOSUB 64000
  136. 2054 IF LEFT$(X$(M),1)="S" OR LEFT$(X$(M),1)="s" OR LEFT$(Y$(M),1)="S" OR LEFT$(Y$(M),1)="s" THEN GOTO 2500
  137. 2075 IF LP=1 THEN LPRINT"X( ";J;" )= ";X$(J);TAB(40);"Y( ";J;" )= ";Y$(J)
  138. 2077 M=M+1:IF MR>14 THEN MR=1:MC=MC+26:IF MC>55 THEN MC=1
  139. 2078 IF MR2=1 THEN 2038
  140. 2080 NEXT J
  141. 2090 GOTO 120
  142. 2500 X$(M)="END":Y$(M)="END":LOCATE 25,1:PRINT"(S)top encountered.  More Data (Y or N).";:INPUT;A$
  143. 2510 IF A$ = "Y" OR A$ = "y" THEN MR=MR-1:LOCATE 25,1:PRINT"                                                    ";:GOTO 2040
  144. 2520 GOTO 4620
  145. 3000 CLS:GOSUB 38000:PRINT"DATA CORRECTION":PRINT" "
  146. 3011 CLS:GOSUB 38000:M=1:MR=1:MC=1:MR2=0
  147. 3012 PRINT "╔═══════════╦═══════════════════════════════════════════════════════╦═════════╗"
  148. 3013 PRINT "║ CURVEFIT  ║  Version 2.25a   MAY  09, 1992      by Thomas S. Cox  ║SHAREWARE║"
  149. 3014 PRINT "╠═══════════╩═══════════════════════════════════════════════════════╩═════════╣"
  150. 3015 PRINT "║ DATA CORRECTION| <ESC> for Data # to Exit, 'D' or 'd' for X or Y to Delete  ║"
  151. 3016 PRINT "╟───┬──────────┬──────────┬───┬──────────┬──────────┬───┬──────────┬──────────╢"
  152. 3017 PRINT "║PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  ║"
  153. 3018 PRINT "╟───┼──────────┼──────────┼───┼──────────┼──────────┼───┼──────────┼──────────╢"
  154. 3019 FOR I=1 TO 14:PRINT "║   │          │          │   │          │          │   │          │          ║"
  155. 3020 NEXT I
  156. 3033 PRINT "╠═══╧════════╦═╧═════════╦╧═══╧══╦═══════╧═════╦════╧══╦╧══════════╧══════════╣"
  157. 3034 PRINT "║ ENTER DATA ║PT #       ║X VALUE║             ║Y VALUE║                      ║"
  158. 3035 PRINT "╚════════════╩═══════════╩═══════╩═════════════╩═══════╩══════════════════════╝";
  159. 3036 DUMMY$="           ":FOR J=1 TO 999: REM This routine shows data right justified
  160. 3037 LOCATE 7+MR,MC+1:PRINT LEFT$(PR$,3);:LOCATE 7+MR,MC+5:PRINT PR$;:LOCATE 7+MR,MC+16:PRINT PR$;
  161. 3038 IF X$(J)<>"END" OR Y$(J)<>"END" THEN 3045
  162. 3040 LOCATE 23,20:PRINT "░░░░░";:LOCATE 23,20:GOSUB 1900:IF IPD$=CHR$(27) THEN GOTO 120 ELSE PRINT IPD$;:INPUT"",M1$:M1$=IPD$+M1$:M=VAL(M1$):LOCATE 23,20:PRINT USING "#####";M;
  163. 3041 LOCATE 23,36:PRINT"  ░░░░░░░░░ ";:LOCATE 23,36,1,0,7:INPUT;X$(M):IF LEFT$(X$(M),1)="d" OR LEFT$(X$(M),1)="D" THEN X$(M)="DEL":Y$(M)="DEL"
  164. 3042 LOCATE 23,36:PRINT"            ";:LOCATE 23,36:PRINT "  "+X$(M);
  165. 3043 LOCATE 23,58:PRINT"  ░░░░░░░░░ ";:LOCATE 23,58,1,0,7:INPUT;Y$(M):IF LEFT$(Y$(M),1)="d" OR LEFT$(Y$(M),1)="D" THEN Y$(M)="DEL"
  166. 3044 LOCATE 23,58:PRINT"            ";:LOCATE 23,58:PRINT"  "+Y$(M);:MR2=1
  167. 3045 LOCATE 7+MR,MC+1:PRINT USING "###";M;
  168. 3046 IF X$(M)="" THEN X$(M)="DEL"
  169. 3047 IF Y$(M)="" THEN Y$(M)="DEL"
  170. 3048 LOCATE 7+MR,MC+5:XX1=VAL(X$(M)):XX2=LEN(X$(M)):IF XX2<10 THEN P1$=LEFT$(DUMMY$,10-XX2)+X$(M) ELSE IF XX2>10 THEN P1$=RIGHT$(X$(M),10) ELSE P1$=LEFT$(X$(M),10)
  171. 3049 PRINT P1$;:LOCATE 7+MR,MC+16:YY1=VAL(Y$(M)):YY2=LEN(Y$(M)):IF YY2<10 THEN P2$=LEFT$(DUMMY$,10-YY2)+Y$(M) ELSE IF YY2>10 THEN P2$=RIGHT$(Y$(M),10) ELSE P2$=LEFT$(Y$(M),10)
  172. 3050 PRINT P2$:MR=MR+1
  173. 3052 IF M MOD 14=0 THEN MR=1:MC=MC+26
  174. 3053 IF M MOD 42=0 THEN MR=1:MC=1:GOSUB 64000
  175. 3054 IF LEFT$(X$(M),1)="S" OR LEFT$(X$(M),1)="s" OR LEFT$(Y$(M),1)="S" OR LEFT$(Y$(M),1)="s" THEN GOTO 3100
  176. 3075 IF LP=1 THEN LPRINT"X( ";J;" )= ";X$(J);TAB(40);"Y( ";J;" )= ";Y$(J)
  177. 3077 M=M+1:IF MR>14 THEN MR=1:MC=MC+26:IF MC>55 THEN MC=1
  178. 3078 IF MR2=1 THEN 3037
  179. 3080 NEXT J
  180. 3090 GOTO 120
  181. 3100 X$(M)="END":Y$(M)="END":LOCATE 25,1:PRINT"(S)top encountered.  More Data (Y or N).";:INPUT;A$
  182. 3110 IF A$ = "Y" OR A$ = "y" THEN MR=MR-1:LOCATE 25,1:PRINT"                                                    ";:GOTO 3040
  183. 3120 GOTO 3430
  184. 3430 CLS:PRINT "Rearranging Data for Deletions"
  185. 3470 K1=1
  186. 3480 FOR I= 1 TO 999
  187. 3490 X1$(I)=X$(I): Y1$(I)=Y$(I): NEXT I
  188. 3540 FOR I= 1 TO 999
  189. 3545 IF X1$(I)="DEL" OR Y1$(I)="DEL" THEN 3580
  190. 3550 IF X1$(I)<>"DEL"  THEN GOSUB 3587
  191. 3570 IF X1$(I)="END" THEN X$(K1)="END":Y$(K1)="END": GOTO 3582
  192. 3580 NEXT I
  193. 3582 FOR I= 1 TO 999: IF X$(I)="END" OR LEFT$(X$(I),1)="S" OR LEFT$(X$(I),1)="s" GOTO 3584
  194. 3583 NEXT I
  195. 3584 IF QZ=1 THEN RETURN ELSE PRINT "There are now "; I-1;" VALID data points. ":FOR I=1 TO 999:NEXT I:GOTO 3590
  196. 3587 X$(K1)=X1$(I): Y$(K1)=Y1$(I): K1=K1+1: RETURN
  197. 3590 Q7=0:IF QA=1 THEN QA=0:GOTO 20045
  198. 3591 IF DE=1 THEN DE=0:GOTO 7090
  199. 3592 IF QZ=1 THEN RETURN
  200. 3600 INPUT "LIST NEW DATA SET (Y/N) ";A2$
  201. 3610 IF A2$="Y" OR A2$= "y" GOTO 9005 ELSE 120
  202. 4000 CLS:GOSUB 38000: PRINT "CALCULATING SUMS AND SUMS OF SQUARES"
  203. 4010 QA=0
  204. 4020 GOTO 20000
  205. 4040 CLS:GOSUB 38000:IF X$(1)="END" OR Y$(1)="END" THEN PRINT "NO DATA ENTERED, CAN'T SHOW COEFFICIENTS!": PRINT CHR$(7): FOR I=1 TO 1000: NEXT I: GOTO 120
  206. 4220 MX=0
  207. 4230 FOR I=1 TO 25
  208. 4240 IF RC(I)>MX THEN 4250
  209. 4245 GOTO 4260
  210. 4250 MX=RC(I):MQ=I
  211. 4260 NEXT I
  212. 4265 IF R2=1 THEN R2=0 :RETURN
  213. 4500 PRINT CHR$(7):A1$="###":A2$="#.####^^^^":A3$="##.####":A0$="###.####"
  214. 4501 INPUT "Output Coefficients to Printer (Y or N) ";Q1$:INPUT "Output Coefficients to Screen (Y or N) ";SO$
  215. 4502 CLS:GOSUB 38000:GOSUB 50000:A5$="EQ#    COEF A      COEF B      COEF C       R^2    R^2 C   EQUATION"
  216. 4503 IF LEFT$(SO$,1)="Y" OR LEFT$(SO$,1)="y" THEN GOTO 4507
  217. 4505 IF LEFT$(Q1$,1)="Y" OR LEFT$(Q1$,1)="y" THEN 4550 ELSE 120
  218. 4507 PRINT "╔═══════════╦════════════════════════════════════╦════════════════════════════╗"
  219. 4508 PRINT "║ CURVEFIT  ║ LISTING OF CALCULATED COEFFICIENTS ║ BEST FIT EQUATION IS #     ║"
  220. 4509 PRINT "╠════╤══════╩═════╤════════════╤════════════╤════╩═╤══════╤═══════════════════╣"
  221. 4510 PRINT "║EQ #│ 'A' COEF.  │ 'B' COEF.  │ 'C' COEF.  │ R²   │R² COR│ EQUATION OF CURVE ║"
  222. 4511 PRINT "╟────┼────────────┼────────────┼────────────┼──────┼──────┼───────────────────╢"
  223. 4512 FOR I=1 TO 16:PRINT "║    │            │            │            │      │      │                   ║":NEXT I
  224. 4515 PRINT "╟────┼────────────┼────────────┼────────────┼──────┼──────┼───────────────────╢"
  225. 4516 PRINT "║BEST│            │            │            │      │      │                   ║"
  226. 4517 PRINT "╚════╧════════════╧════════════╧════════════╧══════╧══════╧═══════════════════╝";
  227. 4518 C1$="#.####":C2$="#######.####":C3$="###"
  228. 4520 LOCATE 2,75:PRINT MQ;
  229. 4522 LOCATE 23,7:V=A(MQ):GOSUB 4700:PRINT USING C2$;A(MQ);:LOCATE 23,20:V=B(MQ):GOSUB 4700:PRINT USING C2$;B(MQ);:LOCATE 23,33:V=C(MQ):GOSUB 4700:PRINT USING C2$;C(MQ);
  230. 4523 LOCATE 23,46:PRINT USING C1$;RR(MQ);:LOCATE 23,53:PRINT USING C1$;RC(MQ);:LOCATE 23,60:PRINT EQ$(MQ);
  231. 4524 MR=6:
  232. 4526 FOR I=1 TO 16
  233. 4528 LOCATE MR,2:PRINT USING C3$;I;:LOCATE MR,7:V=A(I):GOSUB 4700:PRINT USING C2$;A(I):LOCATE MR,20:V=B(I):GOSUB 4700:PRINT USING C2$;B(I)::LOCATE MR,33:V=C(I):GOSUB 4700:PRINT USING C2$;C(I);
  234. 4529 LOCATE MR,46:PRINT USING C1$;RR(I);:LOCATE MR,53:PRINT USING C1$;RC(I);:LOCATE MR,60:PRINT EQ$(I);
  235. 4530 MR=MR+1
  236. 4531 NEXT I
  237. 4532 LOCATE 25,1:INPUT;"PRESS <ENTER> TO SEE THE REMAINING EQUATION COEFFICIENTS";AA$
  238. 4533 '
  239. 4534 LOCATE 25,1:PRINT STRING$(78," ");
  240. 4535 MR=6
  241. 4536 FOR I=1 TO 16
  242. 4538 LOCATE MR,2:PRINT"    ";:LOCATE MR,7:PRINT "            ";:LOCATE MR,20:PRINT "            ";:LOCATE MR,33:PRINT "            ";:LOCATE MR,46:PRINT "      ";:LOCATE MR,53:PRINT "      ";:LOCATE MR,60:PRINT "                   ";
  243. 4540 MR=MR+1:NEXT I
  244. 4542 MR=6:FOR I=17 TO 25
  245. 4544 LOCATE MR,2:PRINT USING C3$;I;:LOCATE MR,7:V=A(I):GOSUB 4700:PRINT USING C2$;A(I);:LOCATE MR,20:V=B(I):GOSUB 4700:PRINT USING C2$;B(I);:LOCATE MR,33:V=C(I):GOSUB 4700:PRINT USING C2$;C(I);:LOCATE MR,46:PRINT USING C1$;RR(I);
  246. 4545 LOCATE MR,53:PRINT USING C1$;RC(I);:LOCATE MR,60:PRINT EQ$(I);
  247. 4546 MR=MR+1:NEXT I
  248. 4548 LOCATE 25,1:INPUT;"ALL EQUATIONS HAVE BEEN LISTED.  PRESS <ENTER> TO RETURN TO MAIN MENU ";AAA$
  249. 4550 IF LP=1 THEN 4574 ELSE 120
  250. 4574 LPRINT A5$:FOR I=1 TO 25:iF A(I)=0 AND B(I)=0 THEN 4588
  251. 4576 LPRINT USING C3$;I;:V=A(I):GOSUB 4700:LPRINT TAB(7);USING C2$;A(I);:V=B(I):GOSUB 4700:LPRINT TAB(20);USING C2$;B(I);:V=C(I):GOSUB 4700:LPRINT TAB(33);USING C2$;C(I);
  252. 4577 LPRINT TAB(46);USING C1$;RR(I);:LPRINT TAB(53);USING C1$;RC(I);:LPRINT TAB(60);EQ$(I)
  253. 4588 NEXT I
  254. 4605 IF LP=1 THEN LPRINT"BASED ON THE VALUE OF RC( )--BEST FITTING CURVE WAS NUMBER";MQ
  255. 4610 LOCATE 25,1:INPUT "PRESS <ENTER> to return to MAIN MENU                                        ";A$:CLS:GOSUB 38000
  256. 4620 IF LP=1 THEN LPRINT CHR$(12)
  257. 4630 GOTO 120
  258. 4700 IF V>9999999.9999# OR V<-999999.9999# OR ABS(V)<.0001 THEN C2$="##.#####^^^^" ELSE C2$="#######.####"
  259. 4701 IF V=0 THEN C2$="#######.####"
  260. 4702 RETURN
  261. 4710 IF ABS(V)<9999.9999# OR V=0 THEN C2$="#####.####":GOTO 4750
  262. 4711 IF ABS(V)<999999.99# THEN C2$="#######.##":GOTO 4750
  263. 4712 IF ABS(V)<99999999# THEN C2$="##########"
  264. 4750 RETURN
  265. 4990 CLS:GOSUB 38000:AZ$=""
  266. 5000 K=0:L=0:IF AZ$="S" THEN INPUT "All data entered, press <Enter> to continue";A$
  267. 5002 AZ$="":Q1$="":Q1A$="":PF$="":PF1$="":CLS:GOSUB 38000:PRINT"RESIDUAL Values of Y, Given EQ#. ":K=1
  268. 5003 CLOSE:LOCATE 25,1:INPUT "Quit and return to main menu or Continue (Q or C) DEFAULT = Continue ";AZ$:CLS:GOSUB 38000
  269. 5004 CLS:GOSUB 38000:IF L=1 AND LP=1 THEN LPRINT CHR$(12)
  270. 5005 IF LEFT$(AZ$,1)="q" OR LEFT$(AZ$,1)="Q" THEN 120
  271. 5006 INPUT "Output results to printer (Y or N) DEFAULT =N";Q1$:INPUT "Output Residuals to a File (Y) or (N) DEFAULT = N";Q1A$:IF LEFT$(Q1A$,1)="Y" OR LEFT$(Q1A$,1)="y" THEN GOTO 57000
  272. 5007 INIT=1:GOSUB 50000:CLS:GOSUB 38000
  273. 5008 PRINT "╔═══════════╦═════════════╤═════╤══════╤════════════════════════════╤═════════╗"
  274. 5009 PRINT "║ CURVEFIT  ║  RESIDUALS  │ EQ# │      │<ENTER> FOR EQ# OF BEST FIT │VER 2.25a║"
  275. 5010 PRINT "╠═══════════╩╤════════════╪═════╧══════╪═════════════╤═════════════╤╧═════════╣"
  276. 5013 PRINT "║X-DATA ENTRY│Y-DATA ENTRY│CALCULATED Y│RESIDUAL VAL │CSUM ABS(RES)│  POINT # ║"
  277. 5014 PRINT "╟────────────┼────────────┼────────────┼─────────────┼─────────────┼──────────╢"
  278. 5015 FOR I=1 TO 16:PRINT"║            │            │            │             │             │          ║":NEXT I
  279. 5029  PRINT"╟────────────┴───┬────────┴───────┬────┴───────────┬─┴─────────────┴┬─────────╢"
  280. 5030 PRINT "║ Coefficients   │A=              │B=              │C=              │R²=      ║"
  281. 5031 PRINT "╚════════════════╧════════════════╧════════════════╧════════════════╧═════════╝";
  282. 5032 EQ=0:LOCATE 2,34:PRINT"▒▒▒▒▒▒";:LOCATE 2,34:INPUT;EQ:IF EQ=0 THEN EQ=MQ:LOCATE 2,34:PRINT MQ;:LOCATE 2,41:PRINT"                            ";:LOCATE 2,41:PRINT"BEST ";EQ$(MQ);:GOTO 5053
  283. 5033 LOCATE 2,34:PRINT"      ";:LOCATE 2,34:PRINT EQ;:IF EQ<0 OR EQ>25 THEN 5038 ELSE IF A(EQ)=0 AND B(EQ)=0 THEN 5043 ELSE LOCATE 2,41:PRINT "                            ";:LOCATE 2,41:PRINT EQ$(EQ);
  284. 5038 IF EQ<0 OR EQ>25 THEN LOCATE 2,41:PRINT"                            ";:LOCATE 2,41:PRINT "EQUATION";EQ;" IS UNDEFINED ";:GOTO 5032
  285. 5039 GOTO 5053
  286. 5043 LOCATE 2,41:PRINT " A AND B = ZERO FOR EQ   ";EQ;:GOTO 5032
  287. 5053 IF LP=1 THEN LPRINT"RESIDUALS FOR EQUATION ";EQ$(EQ):LPRINT" ":lPRINT"X-VALUE","Y-VALUE","P'DICT VALUE","RESIDUAL","CU-SUM RESID   DATA #"
  288. 5054 LOCATE 23,21:V=A(EQ):GOSUB 4700:PRINT USING C2$;A(EQ);:LOCATE 23,38:V=B(EQ):GOSUB 4700:PRINT USING C2$;B(EQ);:LOCATE 23,55:V=C(EQ):GOSUB 4700:PRINT USING C2$;C(EQ);:LOCATE 23,73:PRINT USING"#.####";RC(EQ);
  289. 5060 K=0:ON EQ GOTO 5100,5110,5120,5130,5140,5150,5160,5170,5180,5190,5200,5210,5220,5230,5240,5250,5260,5270,5280,5290,5300,5310,5320,5330,5340,5350
  290. 5100 I=1:YRS=0:WHILE X$(I)<>"END"
  291. 5101 Y=A(1)+B(1)*X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500
  292. 5102 I=I+1
  293. 5103 WEND
  294. 5104 GOTO 5003
  295. 5110 I=1:YRS=0:WHILE X$(I)<>"END": Y=B(2)*X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  296. 5120 I=1:YRS=0:WHILE X$(I)<>"END": Y=1/(A(3)+B(3)*X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  297. 5130 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(4)+B(4)*X(I)+C(4)/X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  298. 5140 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(5)+B(5)/X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  299. 5150 I=1:YRS=0:WHILE X$(I)<>"END": Y=X(I)/(A(6)*X(I)+B(6)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  300. 5160 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(7)+B(7)/X(I)+C(7)/(X(I)*X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  301. 5170 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(8)+B(8)*X(I)+C(8)*X(I)*X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  302. 5180 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(9)*X(I)+B(9)*X(I)*X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  303. 5190 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(10)*X(I)^B(10):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  304. 5200 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(11)*B(11)^X(I):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  305. 5210 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(12)*B(12)^(1/X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  306. 5220 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(13)*X(I)^(B(13)*X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  307. 5230 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(14)*X(I)^(B(14)/X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  308. 5240 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(15)*EXP(B(15)*X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  309. 5250 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(16)*EXP(B(16)/X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  310. 5260 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(17)+B(17)*LOG(X(I)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  311. 5270 I=1:YRS=0:WHILE X$(I)<>"END": Y=1/(A(18)+B(18)*LOG(X(I))):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  312. 5280 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(19)*B(19)^X(I)*X(I)^C(19):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  313. 5290 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(20)*B(20)^(1/X(I))*X(I)^C(20):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  314. 5300 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(21)*EXP(((X(I)-B(21))^2)/C(21)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  315. 5310 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(22)*EXP((LOG(X(I))-B(22))^2/C(22)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  316. 5320 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(23)*X(I)^B(23)*(1-X(I))^C(23):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  317. 5330 I=1:YRS=0:WHILE X$(I)<>"END": Y=A(24)*(X(I)/B(24))^C(24)*EXP(X(I)/B(24)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  318. 5340 I=1:YRS=0:WHILE X$(I)<>"END": Y=1/(A(25)*(X(I)+B(25))^2+C(25)):YR=Y(I)-Y:YRS=YRS+ABS(YR):GOSUB 5500:I=I+1:WEND:GOTO 5003
  319. 5350 REM * END OF RESIDUAL CALCS*
  320. 5500 IF INIT =1 THEN M=1:MR=1:MC=1:MR1=1:MC1=1
  321. 5502 L=1:INIT=0
  322. 5503 IF LEFT$(Q1A$,1)="Y" OR LEFT$(Q1A$,1)="y" THEN PRINT #1, X(I), Y(I), Y, YR
  323. 5505 LOCATE 5+MR,2:V=X(I):GOSUB 4700:PRINT USING C2$;X(I);:LOCATE 5+MR,15:V=Y(I):GOSUB 4700:PRINT USING C2$;Y(I);:LOCATE 5+MR,28:
  324. 5506 V=Y:GOSUB 4700:PRINT USING C2$;Y;:V=YR:LOCATE 5+MR,41:GOSUB 4700:PRINT USING C2$;YR;:LOCATE 5+MR,55:V=YRS:GOSUB 4700:PRINT USING C2$;YRS:LOCATE 5+MR,74:PRINT USING "####";I;
  325. 5507 IF LP=1 THEN V=X(I):GOSUB 4700:LPRINT USING C2$;X(I);:LPRINT TAB(15);:V=Y(I):GOSUB 4700:LPRINT USING C2$;Y(I);:LPRINT TAB(28);
  326. 5508 IF LP=1 THEN V=Y:GOSUB 4700:LPRINT USING C2$;Y;:V=YR:LPRINT TAB(41);:GOSUB 4700:LPRINT USING C2$;YR;:LPRINT TAB(55);:V=YRS:GOSUB 4700:LPRINT USING C2$;YRS;:LPRINT TAB(75);USING "####";I
  327. 5509 MR=MR+1:M=M+1:IF MR MOD 17=0 THEN MR=1:GOSUB 5600
  328. 5511 IF LP=1 THEN 5515
  329. 5515 IF LP=1 AND (INT(M/60)=(M/60)) THEN LPRINT CHR$(12)
  330. 5520 RETURN
  331. 5600 LOCATE 25,1:PRINT" <ESC> TO MAIN MENU;  <ENTER> FOR MORE DATA";:A$=INKEY$
  332. 5601 IF A$=CHR$(27) THEN 120 ELSE IF A$=CHR$(13) THEN 5602 ELSE 5600
  333. 5602 LOCATE 25,1:PRINT"                                                                       ";
  334. 5603 FOR I3=1 TO 16:LOCATE 5+I3,2:PRINT"            ";:LOCATE 5+I3,15:PRINT"            ";:LOCATE 5+I3,28:PRINT"            ";:LOCATE 5+I3,41:PRINT"             ";:LOCATE 5+I3,55:PRINT"             ";:LOCATE 5+I3,74:PRINT"    ";:NEXT I3
  335. 5620 RETURN
  336. 6000 REM * STORE DATA ON DISK (RAW DATA ONLY) *
  337. 6030 CLS:PRINT "This routine will store RAW DATA on Disk"
  338. 6035 ON ERROR GOTO 63000
  339. 6040 INPUT "Please enter File Name for Data Storage ";A4$
  340. 6050 OPEN "O",1,A4$
  341. 6060 FOR I=1 TO 999
  342. 6065 IF X$(I)="END" AND Y$(I)="END" THEN CLOSE 1:GOTO 6080
  343. 6070 PRINT #1,X$(I),Y$(I):NEXT I:CLOSE 1
  344. 6080 PRINT "Data have been stored to disk with File Name ";A4$
  345. 6090 INPUT "Press <Enter> to return to MAIN MENU";Z0
  346. 6100 GOTO 120
  347. 7000 REM * LOAD DATA FROM DISK *
  348. 7030 CLS:PRINT"This routine will load DATA from Disk"
  349. 7035 ON ERROR GOTO 61000
  350. 7036 path$="":INPUT "PLEASE ENTER PATH NAME FOR DATA FILES <ENTER ASSUMES DEFAULT> ";PATH$
  351. 7037 CLS: FILES PATH$+"*.*"
  352. 7040 INPUT "PLEASE Enter File Name for Data ";A4$
  353. 7041 FOR I=1 TO 999:X$(I)="END":Y$(I)="END":NEXT I
  354. 7045 NX=0:NY=0:FOR I=1 TO 25:A(I)=0:B(I)=0:C(I)=0:R(I)=0:RC(I)=0:NEXT I
  355. 7046 A4$=PATH$+A4$
  356. 7050 OPEN "I",1,A4$
  357. 7060 FOR I=1 TO 999
  358. 7065 IF EOF(1) THEN PRINT"ALL DATA LOADED":K=I:FOR J=K TO 999:X$(J)="END":Y$(J)="END":NEXT J:GOTO 7075
  359. 7070 INPUT #1,X$(I)
  360. 7071 IF INSTR(2,X$(I)," ")<>0 THEN 7200
  361. 7073 INPUT #1,Y$(I):NEXT I
  362. 7075 CLOSE 1
  363. 7080 PRINT "Data loaded from file ";A4$
  364. 7082 FOR I=1 TO 999:IF X$(I)="" THEN X$(I)="DEL":Y$(I)="DEL"
  365. 7083 IF X$(I)="END" THEN IF X$(1)<>"DEL" THEN 7090 ELSE DE=1:GOTO 3430
  366. 7084 NEXT I:DE=1:GOTO 3430
  367. 7090 INPUT "Press ENTER to Continue";A9:GOTO 3430
  368. 7100 GOTO 120
  369. 7200 CLOSE 1:OPEN "I",1,A4$
  370. 7210 FOR I=1 TO 999
  371. 7220 IF EOF(1) THEN PRINT"ALL DATA LOADED":K=I:FOR J=K TO 999:X$(J)="END":Y$(J)="END":NEXT J:GOTO 7275
  372. 7230 INPUT #1,DUMM$
  373. 7240 PM=INSTR(2,DUMM$," "):X$(I)=LEFT$(DUMM$,PM):Y$(I)=RIGHT$(DUMM$,LEN(DUMM$)-PM):NEXT I
  374. 7275 GOTO 7075
  375. 8000 CLS:GOSUB 38000:PRINT"PROGRAM EXECUTION HAS BEEN TERMINATED"
  376. 8010 INPUT "Before exiting do you wish to store data on disk (Y or N)";A$
  377. 8020 IF LEFT$(A$,1)="N" OR LEFT$(A$,1)="n"  THEN END
  378. 8030 GOTO 6030
  379. 9000 REM * LIST RAW DATA *
  380. 9005 CLS:GOSUB 38000:PRINT "LIST OF DATA ENTERED"
  381. 9006 INPUT "Do you want to list data on printer (Y or N)";Q1$
  382. 9007 GOSUB 50000:GOTO 63700
  383. 9008 IF LP=1 THEN LPRINT"LISTING OF DATA":LPRINT" "
  384. 9009 IF LP=0 THEN 9100
  385. 9010 FOR I=1 TO 999
  386. 9020 IF X$(I)="END" OR Y$(I)="END" THEN LPRINT CHR$(12):GOTO 9100
  387. 9065 IF LP=1 THEN LPRINT"X( ";I;" )= ";X$(I);TAB(32);"Y( ";I;" )= ";Y$(I)
  388. 9066 IF LP=1 AND (INT(I/60)=(I/60)) THEN LPRINT CHR$(12)
  389. 9074 NEXT I:IF LP=1 THEN LPRINT CHR$(12)
  390. 9100 IF Q7=1 THEN  Q7=0:RETURN
  391. 9110 GOTO 120
  392. 10000 CLS: GOSUB 38000
  393. 10010 PRINT "╔═══════════════════════════════════════════════════════════════════════════╗"
  394. 10020 PRINT "║     LISTING of Equations Fitted with CURVEFIT Version 2.25a   (05/03/92)  ║"
  395. 10030 PRINT "╟────────────────────────────────────┬──────────────────────────────────────╢"
  396. 10040 PRINT "║  1. Y=A+B*X       STR. LINE        │   2. Y=B*X           LINE THRU ORG.  ║"
  397. 10050 PRINT "║  3. Y=1/(A+B*X)   REC. STR LINE    │   4. Y=A+B*X+C/X     LIN AND RECIP.  ║"
  398. 10060 PRINT "║  5. Y=A+B/X       HYPERBOLA        │   6. Y=X/(A*X+B)     RECIP HYPERBOLA ║"
  399. 10070 PRINT "║  7. Y=A+B/X+C/X*X 2ND ORD HYP      │   8. Y=A+B*X+C*X*X   PARABOLA        ║"
  400. 10080 PRINT "║  9. Y=A*X+B*X*X   PAR AT ORIGIN    │  10. Y=A*X^B         POWER           ║"
  401. 10090 PRINT "║ 11. Y=A*B^X       MOD. POWER       │  12. Y=A*B^(1/X)     ROOT            ║"
  402. 10100 PRINT "║ 13. Y=A*X^(B*X)   SUPER GEOMET.    │  14. Y=A*X^(B/X)     MOD GEOMETRIC   ║"
  403. 10110 PRINT "║ 15. Y=A*e^(B*X)   EXPONENTIAL      │  16. Y=A*e^(B/X)     MOD EXPONENTIAL ║"
  404. 10120 PRINT "║ 17. Y=A+B*ln(X)   LOGARITHMIC      │  18. Y=1/(A+B*ln(X))   RECIP LOG     ║"
  405. 10130 PRINT "║ 19. Y=A*B^X*X^C   HOERL FUNCTION   │  20. Y=A*B^(1/X)*X^C   MOD HOERL     ║"
  406. 10140 PRINT "║ 21. Y=A*e^(((X-B)^2)/C)  NORMAL    │  22. Y=A*e^((ln(X)-B)^2/C) LOG NORMAL║"
  407. 10150 PRINT "║ 23. Y=A*X^B*(1-X)^C   BETA         │  24. Y=A*(X/B)^C*e^(X/B)   GAMMA     ║"
  408. 10160 PRINT "║ 25. Y=1/(A*(X+B)^2+C) CAUCHY       │                                      ║"
  409. 10170 PRINT "╟────────────────────────────────────┴──────────────────────────────────────╢"
  410. 10180 PRINT "║      NOTES:  A.  Values of X and Y may be positive, negative, or zero     ║"
  411. 10190 PRINT "║              B.  Only 999 values of X and Y can be used.                  ║"
  412. 10200 PRINT "╟───────────────────────────────────────────────────────────────────────────╢"
  413. 10210 PRINT "║      Press <RETURN> to continue program execution                         ║"
  414. 10220 PRINT "╚═══════════════════════════════════════════════════════════════════════════╝"
  415. 10230 A$=INKEY$:IF A$<>CHR$(13) THEN 10230 ELSE 10460
  416. 10460 IF R1=1 THEN RETURN ELSE 120
  417. $SEGMENT
  418. 12000 FOR I=1 TO 25:A(I)=0:B(I)=0:C(I)=0:RR(I)=0:RC(I)=0:NEXT I
  419. 12005 REM * EQUATION 1 STRAIGHT LINE
  420. 12008 ON ERROR GOTO 62101
  421. 12010 A(1)=(R(17)*R(18)-R(16)*R(20))/(R(17)*R(21)-(R(16)*R(16)))
  422. 12020 B(1)=(R(20)*R(21)-R(16)*R(18))/(R(17)*R(21)-(R(16)*R(16)))
  423. 12030 RR(1)=(A(1)*R(18)+B(1)*R(20)-(R(18)*R(18))/R(21))/(R(19)-(R(18)*R(18))/R(21))
  424. 12040 RC(1)=1-(((1-RR(1))*(R(21)-1))/(R(21)-2))
  425. 12050 C(1)=0
  426. 12060 REM * EQUATION 2 STRAIGHT LINE THROUGH ORIGIN *
  427. 12061 A(2)=0:B(2)=R(20)/R(17):RR(2)=0:RC(2)=0:C(2)=0
  428. 12070 ON ERROR GOTO 62102: REM The rest of this routine supplied by J. Cargal
  429. 12071 SSTO=R(19)-((R(18)/R(21))*R(18)):REM R^2=MAX{0,1-(SSE/SSTO)}
  430. 12072 SSE=0: FOR I=1 TO R(21):SSE=SSE+(Y(I)-B(2)*X(I))^2:NEXT I
  431. 12080 RR(2)=1-SSE/SSTO:IF RR(2)<0 THEN RR(2)=0
  432. 12081 IF RR(2)>1 THEN RR(2)=1:RC(2)=1
  433. 12082 RC(2)=RR(2)
  434. 12140 REM * EQUATION 3 RECIPROCAL OF STRAIGHT LINE
  435. 12145 ON ERROR GOTO 62103
  436. 12150 A(3)=(R(17)*R(24)-R(16)*R(34))/(R(17)*R(21)-(R(16)*R(16)))
  437. 12160 B(3)=(R(21)*R(34)-R(16)*R(24))/(R(17)*R(21)-(R(16)*R(16)))
  438. 12170 RR(3)=(A(3)*R(24)+B(3)*R(34)-((R(24)*R(24))/R(21)))/(R(25)-(R(24)*R(24))/R(21))
  439. 12180 RC(3)=1-(((1-RR(3))*(R(21)-1))/(R(21)-2))
  440. 12190 C(3)=0
  441. 12200 REM * EQUATION 4  COMBINED LINEAR AND RECIPROCAL *
  442. 12201 ON ERROR GOTO 62104
  443. 12220 S1=R(17)*R(21)-(R(16)*R(16))
  444. 12230 S2=R(21)*R(35)-R(18)*R(22)
  445. 12240 S3=(R(21)*R(21))-R(16)*R(22)
  446. 12250 S4=R(20)*R(21)-R(16)*R(18)
  447. 12260 S5=R(21)*R(23)-(R(22)*R(22))
  448. 12270 C(4)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  449. 12280 B(4)=(S4-S3*C(4))/S1
  450. 12290 A(4)=(R(18)-B(4)*R(16)-C(4)*R(22))/R(21)
  451. 12300 RR(4)=(A(4)*R(18)+B(4)*R(20)+C(4)*R(35)-(R(18)*R(18))/R(21))/(R(19)-(R(18)*R(18))/R(21))
  452. 12310 RC(4)=1-(((1-RR(4))*(R(21)-1))/(R(21)-3))
  453. 12320 REM * EQUATION 5  HYPERBOLA *
  454. 12321 ON ERROR GOTO 62105
  455. 12330 S1=R(21)*R(23)-(R(22)*R(22))
  456. 12340 A(5)=(R(18)*R(23)-R(22)*R(35))/S1
  457. 12360 B(5)=(R(21)*R(35)-R(18)*R(22))/S1
  458. 12370 RR(5)=(A(5)*R(18)+B(5)*R(35)-(R(18)*R(18))/R(21))/(R(19)-(R(18)*R(18))/R(21))
  459. 12380 RC(5)=1-(((1-RR(5))*(R(21)-1))/(R(21)-2))
  460. 12390 C(5)=0
  461. 12400 REM * EQUATION 6  RECIPROCAL OF A HYPERBOLA *
  462. 12401 ON ERROR GOTO 62106
  463. 12420 S1=R(21)*R(23)-(R(22)*R(22))
  464. 12430 A(6)=(R(23)*R(24)-R(22)*R(26))/S1
  465. 12440 B(6)=(R(21)*R(26)-R(22)*R(24))/S1
  466. 12450 RR(6)=(A(6)*R(24)+B(6)*R(26)-(R(24)*R(24))/R(21))/(R(25)-(R(24)*R(24))/R(21))
  467. 12460 RC(6)=1-(((1-RR(6))*(R(21)-1))/(R(21)-2))
  468. 12462 C(6)=0
  469. 12470 REM * EQUATION 7  SECOND ORDER HYPERBOLA *
  470. 12471 ON ERROR GOTO 62107
  471. 12490 S1=R(21)*R(23)-(R(22)*R(22))
  472. 12500 S2=R(21)*R(38)-R(18)*R(23)
  473. 12510 S3=R(21)*R(41)-R(22)*R(23)
  474. 12520 S4=R(21)*R(35)-R(18)*R(22)
  475. 12530 S5=R(21)*R(44)-(R(23)*R(23))
  476. 12535 IF (S1*S5-S3*S3)=0 THEN 12620
  477. 12540 C(7)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  478. 12545 IF C(7)>=9.999999E+37 THEN A(7)=0:B(7)=0:C(7)=0:GOTO 12590
  479. 12550 B(7)=(S4-S3*C(7))/S1
  480. 12560 A(7)=(R(18)-C(7)*R(23)-B(7)*R(22))/R(21)
  481. 12570 RR(7)=(A(7)*R(18)+B(7)*R(35)+C(7)*R(38)-(R(18)*R(18))/R(21))/(R(19)-(R(18)*R(18))/R(21))
  482. 12580 RC(7)=1-(((1-RR(7))*(R(21)-1))/(R(21)-3))
  483. 12590 REM * EQUATION 8  PARABOLA *
  484. 12591 ON ERROR GOTO 62108
  485. 12620 S1=R(17)*R(21)-(R(16)*R(16))
  486. 12630 S2=R(21)*R(36)-R(17)*R(18)
  487. 12640 S3=R(21)*R(40)-R(16)*R(17)
  488. 12650 S4=R(20)*R(21)-R(16)*R(18)
  489. 12660 S5=R(21)*R(43)-(R(17)*R(17))
  490. 12670 C(8)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  491. 12680 B(8)=(S4-S3*C(8))/S1
  492. 12690 A(8)=(R(18)-C(8)*R(17)-B(8)*R(16))/R(21)
  493. 12700 RR(8)=(A(8)*R(18)+B(8)*R(20)+C(8)*R(36)-(R(18)*R(18))/R(21))/(R(19)-(R(18)*R(18))/R(21))
  494. 12710 RC(8)=1-(((1-RR(8))*(R(21)-1))/(R(21)-3))
  495. 12720 REM * EQUATION 9  PARABOLA THROUGH ORIGIN *
  496. 12721 ON ERROR GOTO 62109
  497. 12750 S1=R(17)*R(43)-(R(40)*R(40))
  498. 12760 A(9)=(R(20)*R(43)-R(36)*R(40))/S1
  499. 12770 B(9)=(R(17)*R(36)-R(20)*R(40))/S1
  500. 12780 C(9)=0: RR(9)=0: RC(9)=0
  501. 12810 REM * EQUATION 10  POWER *
  502. 12811 ON ERROR GOTO 62110
  503. 12820 IF NX=1 OR NY=1 THEN 13000
  504. 12840 S1=R(21)*R(29)-(R(28)*R(28))
  505. 12850 S3=(R(29)*R(30)-R(28)*R(32))/S1
  506. 12860 A(10)=EXP((R(29)*R(30)-R(28)*R(32))/S1)
  507. 12870 B(10)=(R(21)*R(32)-R(28)*R(30))/S1
  508. 12875 RR(10)=(S3*R(30)+B(10)*R(32)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  509. 12880 IF RR(10)<0 OR RR(10)>1 THEN A(10)=0:B(10)=0:GOTO 13000
  510. 12890 RC(10)=1-(((1-RR(10))*(R(21)-1))/(R(21)-2))
  511. 12895 C(10)=0
  512. 13000 REM * EQUATION 11  MODIFIED POWER *
  513. 13001 ON ERROR GOTO 62111
  514. 13010 IF NY=1 THEN 13110
  515. 13020 S1=R(17)*R(21)-(R(16)*R(16))
  516. 13030 S2=(R(17)*R(30)-R(16)*R(46))/S1
  517. 13040 S3=(R(21)*R(46)-R(16)*R(30))/S1
  518. 13060 A(11)=EXP(S2)
  519. 13070 B(11)=EXP(S3)
  520. 13080 RR(11)=(S2*R(30)+S3*R(46)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  521. 13090 RC(11)=1-(((1-RR(11))*(R(21)-1))/(R(21)-2))
  522. 13100 C(11)=0
  523. 13110 REM * EQUATION 12  ROOT *
  524. 13111 ON ERROR GOTO 62112
  525. 13120 IF NY=1 THEN 13210
  526. 13140 S1=R(23)*R(21)-(R(22)*R(22))
  527. 13150 S2=(R(23)*R(30)-R(22)*R(47))/S1
  528. 13160 S3=(R(21)*R(47)-R(22)*R(30))/S1
  529. 13165 IF S2>87 OR S3>87 OR S2<-86 OR S3<-86 THEN 13210:REM Error trap to keep
  530. 13170 A(12)=EXP(S2):REM QB4 and TB1.1 from crashing and to prevent QB3 from
  531. 13180 B(12)=EXP(S3):REM giving erroneous results.  Added 4/4/88
  532. 13190 RR(12)=(S2*R(30)+S3*R(47)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  533. 13200 RC(12)=1-(((1-RR(12))*(R(21)-1))/(R(21)-2)):C(12)=0
  534. 13210 REM * EQUATION 13  SUPER GEOMETRIC *
  535. 13211 ON ERROR GOTO 62113
  536. 13220 IF NX=1 OR NY=1 THEN 13400
  537. 13240 S1=R(21)*R(49)-(R(48)*R(48))
  538. 13250 S2=(R(30)*R(49)-R(48)*R(50))/S1
  539. 13260 A(13)=EXP(S2)
  540. 13270 B(13)=(R(21)*R(50)-R(30)*R(48))/S1
  541. 13280 RR(13)=(S2*R(30)+B(13)*R(50)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  542. 13290 RC(13)=1-(((1-RR(13))*(R(21)-1))/(R(21)-2))
  543. 13295 C(13)=0
  544. 13300 REM * EQUATION 14  MODIFIED GEOMETRIC *
  545. 13301 ON ERROR GOTO 62114
  546. 13330 S1=R(21)*R(53)-(R(63)*R(63))
  547. 13340 S2=(R(30)*R(53)-R(63)*R(58))/S1
  548. 13350 A(14)=EXP(S2)
  549. 13360 B(14)=(R(21)*R(58)-R(30)*R(63))/S1
  550. 13370 RR(14)=(S2*R(30)+B(14)*R(58)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  551. 13380 RC(14)=1-(((1-RR(14))*(R(21)-1))/(R(21)-2))
  552. 13390 C(14)=0
  553. 13400 REM * EQUATION 15  EXPONENTIAL *
  554. 13401 ON ERROR GOTO 62115
  555. 13420 IF NY=1 THEN 13600
  556. 13430 S1=R(17)*R(21)-(R(16)*R(16))
  557. 13440 S2=(R(17)*R(30)-R(16)*R(46))/S1
  558. 13450 A(15)=EXP(S2)
  559. 13460 B(15)=(R(21)*R(46)-R(16)*R(30))/S1
  560. 13470 RR(15)=(S2*R(30)+R(46)*B(15)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  561. 13480 RC(15)=1-(((1-RR(15))*(R(21)-1))/(R(21)-2))
  562. 13490 C(15)=0
  563. 13500 REM * EQUATION 16  MODIFIED EXPONENTIAL *
  564. 13501 ON ERROR GOTO 62116
  565. 13530 S1=R(23)*R(21)-(R(22)*R(22))
  566. 13540 S2=(R(23)*R(30)-R(22)*R(47))/S1
  567. 13550 A(16)=EXP(S2)
  568. 13560 B(16)=(R(21)*R(47)-R(22)*R(30))/S1
  569. 13570 RR(16)=(S2*R(30)+B(16)*R(47)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  570. 13580 RC(16)=1-(((1-RR(16))*(R(21)-1))/(R(21)-2)):C(16)=0
  571. 13600 REM * EQUATION 17  LOGARITHMIC *
  572. 13601 ON ERROR GOTO 62117
  573. 13620 IF NX=1 THEN 14000
  574. 13630 S1=R(21)*R(29)-(R(28)*R(28))
  575. 13640 A(17)=(R(18)*R(29)-R(28)*R(51))/S1
  576. 13650 B(17)=(R(21)*R(51)-R(18)*R(28))/S1
  577. 13660 RR(17)=(A(17)*R(18)+B(17)*R(51)-(R(18)*R(18))/R(21))/(R(19)-(R(18)*R(18))/R(21))
  578. 13670 C(17)=0: RC(17)=1-(((1-RR(17))*(R(21)-1))/(R(21)-2))
  579. 13680 REM * EQUATION 18  RECIPROCAL OF LOGARITHMIC *
  580. 13681 ON ERROR GOTO 62118
  581. 13710 S1=R(21)*R(29)-(R(28)*R(28))
  582. 13720 A(18)=(R(24)*R(29)-R(28)*R(52))/S1
  583. 13730 B(18)=(R(21)*R(52)-R(24)*R(28))/S1
  584. 13740 RR(18)=(A(18)*R(24)+B(18)*R(52)-(R(24)*R(24))/R(21))/(R(25)-(R(24)*R(24))/R(21))
  585. 13750 C(18)=0:RC(18)=1-(((1-RR(18))*(R(21)-1))/(R(21)-2))
  586. 14000 REM * EQUATION 19  HOERL FUNCTION *
  587. 14001 ON ERROR GOTO 62119
  588. 14020 IF NX=1 OR NY=1 THEN 14300
  589. 14030 S1=R(17)*R(21)-(R(16)*R(16))
  590. 14040 S2=R(21)*R(32)-R(28)*R(30)
  591. 14050 S3=R(21)*R(48)-R(16)*R(28)
  592. 14060 S4=R(21)*R(46)-R(16)*R(30)
  593. 14070 S5=R(21)*R(29)-(R(28)*R(28))
  594. 14080 C(19)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  595. 14090 S6=(S4-S3*C(19))/S1
  596. 14100 S7=(R(30)-C(19)*R(28)-S6*R(16))/R(21)
  597. 14105 IF S7>87 OR S8>87 THEN A(19)=0:B(19)=0:C(19)=0:GOTO 14150
  598. 14110 B(19)=EXP(S6)
  599. 14120 A(19)=EXP(S7)
  600. 14130 RR(19)=(S7*R(30)+S6*R(46)+C(19)*R(32)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  601. 14140 RC(19)=1-(((1-RR(19))*(R(21)-1))/(R(21)-3))
  602. 14150 REM * EQUATION 20  MODIFIED HOERL FUNCTION *
  603. 14151 ON ERROR GOTO 62120
  604. 14180 S1=R(21)*R(23)-(R(22)*R(22))
  605. 14190 S2=R(21)*R(32)-R(28)*R(30)
  606. 14200 S3=R(21)*R(45)-R(22)*R(28)
  607. 14210 S4=R(21)*R(47)-R(22)*R(30)
  608. 14220 S5=R(21)*R(29)-(R(28)*R(28))
  609. 14230 C(20)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  610. 14240 S6=(S4-S3*C(20))/S1
  611. 14250 S7=(R(30)-C(20)*R(28)-S6*R(22))/R(21)
  612. 14255 IF S6>87 OR S7>87 THEN A(20)=0:B(20)=0:C(20)=0:GOTO 14300
  613. 14260 A(20)=EXP(S7)
  614. 14270 B(20)=EXP(S6)
  615. 14280 RR(20)=(S7*R(30)+S6*R(47)+C(20)*R(32)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  616. 14290 RC(20)=1-(((1-RR(20))*(R(21)-1))/(R(21)-3))
  617. 14300 REM * EQUATION 21  NORMAL DISTRIBUTION *
  618. 14301 ON ERROR GOTO 62121
  619. 14310 IF NY=1 THEN 14460
  620. 14330 S1=R(17)*R(21)-(R(16)*R(16))
  621. 14340 S2=R(21)*R(54)-R(17)*R(30)
  622. 14350 S3=R(21)*R(40)-R(16)*R(17)
  623. 14360 S4=R(21)*R(46)-R(16)*R(30)
  624. 14370 S5=R(21)*R(43)-(R(17)*R(17))
  625. 14380 S6=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  626. 14390 S7=(S4-S3*S6)/S1
  627. 14400 S8=(R(30)-S7*R(16)-S6*R(17))/R(21)
  628. 14410 A(21)=EXP(S8-((S7*S7)/(4*S6)))
  629. 14420 B(21)=-S7/(2*S6)
  630. 14430 C(21)=1/S6
  631. 14440 RR(21)=(S8*R(30)+S7*R(46)+S6*R(54)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  632. 14450 RC(21)=1-(((1-RR(21))*(R(21)-1))/(R(21)-3))
  633. 14460 REM * EQUATION 22  LOG NORMAL DISTRIBUTION *
  634. 14461 ON ERROR GOTO 62122
  635. 14470 IF NX=1 OR NY=1 THEN 14620
  636. 14490 S1=R(21)*R(29)-(R(28)*R(28))
  637. 14500 S2=R(21)*R(57)-R(29)*R(30)
  638. 14510 S3=R(21)*R(55)-R(28)*R(29)
  639. 14520 S4=R(21)*R(32)-R(28)*R(30)
  640. 14530 S5=R(21)*R(56)-(R(29)*R(29))
  641. 14540 S6=(S1*S2-S3*S4)/(S1*S5-(S3*S3)):IF S6=0 THEN 14620: REM Required for QB4
  642. 14550 S7=(S4-S3*S6)/S1
  643. 14560 S8=(R(30)-S7*R(28)-S6*R(29))/R(21)
  644. 14570 Z=(S8-(S7*S7)/(4*S6)):IF Z>85 THEN 14620 ELSE A(22)=EXP(Z)
  645. 14580 B(22)=-S7/(2*S6)
  646. 14590 C(22)=1/S6
  647. 14600 RR(22)=(S8*R(30)+S7*R(32)+S6*R(57)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  648. 14610 RC(22)=1-(((1-RR(22))*(R(21)-1))/(R(21)-3))
  649. 14620 REM * EQUATION 23  BETA DISTRIBUTION *
  650. 14621 ON ERROR GOTO 62123
  651. 14645 IF Q9=1 THEN GOTO 14790
  652. 14650 S1=R(21)*R(29)-(R(28)*R(28))
  653. 14660 S2=R(21)*R(62)-R(30)*R(59)
  654. 14670 S3=R(21)*R(61)-R(28)*R(59)
  655. 14680 S4=R(21)*R(32)-R(28)*R(30)
  656. 14690 S5=R(21)*R(60)-(R(59)*R(59))
  657. 14700 C(23)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  658. 14710 B(23)=(S4-S3*C(23))/S1
  659. 14720 S6=(R(30)-B(23)*R(28)-C(23)*R(59))/R(21)
  660. 14730 A(23)=EXP(S6)
  661. 14740 RR(23)=(S6*R(30)+B(23)*R(32)+C(23)*R(62)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  662. 14750 RC(23)=1-(((1-RR(23))*(R(21)-1))/(R(21)-3))
  663. 14760 REM * EQUATION 24  GAMMA DISTRIBUTION *
  664. 14761 ON ERROR GOTO 62124
  665. 14765 IF NX=1 OR NY=1 THEN 14930
  666. 14790 S1=R(17)*R(21)-(R(16)*R(16))
  667. 14800 S2=R(21)*R(32)-R(28)*R(30)
  668. 14810 S3=R(21)*R(48)-R(16)*R(28)
  669. 14820 S4=R(21)*R(46)-R(16)*R(30)
  670. 14830 S5=R(21)*R(29)-(R(28)*R(28))
  671. 14840 C(24)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  672. 14850 S6=(S4-S3*C(24))/S1
  673. 14860 S7=(R(30)-S6*R(16)-C(24)*R(28))/R(21)
  674. 14865 IF S6<=0 THEN B(24)=0:C(24)=0:GOTO 14930
  675. 14870 B(24)=1/S6
  676. 14880 A(24)=EXP(S7+C(24)*LOG(1/S6))
  677. 14890 RR(24)=(S7*R(30)+S6*R(46)+C(24)*R(32)-(R(30)*R(30))/R(21))/(R(31)-(R(30)*R(30))/R(21))
  678. 14895 RC(24)=1-(((1-RR(24))*(R(21)-1))/(R(21)-3))
  679. 14920 REM * EQUATION 25  CAUCHY DISTRIBUTION *
  680. 14921 ON ERROR GOTO 62125
  681. 14930 S1=R(17)*R(21)-(R(16)*R(16))
  682. 14932 S2=R(21)*R(37)-R(17)*R(24)
  683. 14934 S3=R(21)*R(40)-R(16)*R(17)
  684. 14936 S4=R(21)*R(34)-R(16)*R(24)
  685. 14938 S5=R(21)*R(43)-(R(17)*R(17))
  686. 14940 A(25)=(S1*S2-S3*S4)/(S1*S5-(S3*S3))
  687. 14942 S6=(S4-S3*A(25))/S1
  688. 14944 S7=(R(24)-S6*R(16)-A(25)*R(17))/R(21)
  689. 14946 B(25)=(S6/(2*A(25)))
  690. 14948 C(25)=S7-((S6*S6)/(4*A(25)))
  691. 14950 RR(25)=(S7*R(24)+S6*R(34)+A(25)*R(37)-(R(24)*R(24))/R(21))/(R(25)-(R(24)*R(24))/R(21))
  692. 14952 RC(25)=1-(((1-RR(25))*(R(21)-1))/(R(21)-3))
  693. 14954 PRINT"COEFFICIENTS NOW CALCULATED "
  694. 14956 FOR I=1 TO 25
  695. 14958 IF RR(I)<0 OR RR(I)>1.01 THEN A(I)=0:B(I)=0:RC(I)=0:C(I)=0:RR(I)=0
  696. 14960 IF RC(I)<0 OR RC(I)>1.01 THEN RC(I)=0
  697. 14970 NEXT I
  698. 14972 GOTO 4040
  699. $SEGMENT
  700. 15002 AZ$="":Q1$="":Q1A$="":PF$="":PF1$="":CLS:GOSUB 38000:PRINT"Predicted Value of X, Given Value for Y. ":K=1
  701. 15003 CLOSE:LOCATE 25,1:INPUT "Quit and return to main menu or Predict (Q or P) DEFAULT = (P)redict ";AZ$:CLS:GOSUB 38000
  702. 15004 CLS:GOSUB 38000:IF L=1 AND LP=1 THEN LPRINT CHR$(12)
  703. 15005 IF LEFT$(AZ$,1)="q" OR LEFT$(AZ$,1)="Q" THEN 120
  704. 15006 INPUT "Output results to printer (Y or N) ";Q1$:INPUT "Output Predictions to a File (Y) or (N) ";Q1A$:IF LEFT$(Q1A$,1)="Y" OR LEFT$(Q1A$,1)="y" THEN GOTO 58000
  705. 15007 INIT=1:GOSUB 50000:CLS:GOSUB 38000
  706. 15008 PRINT "╔═══════════╦═════════════╤═════╤══════╤════════════════════════════╦═════════╗"
  707. 15009 PRINT "║ CURVEFIT  ║ PREDICTIONS │ EQ# │      │<ENTER> for EQ# of BEST FIT ║VER 2.25a║"
  708. 15010 PRINT "╠═══════╤═══╩═════════════╪═════╧╤═════╧═══════════╤══════╤═════════╩═════════╣"
  709. 15011 PRINT "║ START │                 │ STOP │                 │ STEP │                   ║"
  710. 15012 PRINT "╟───────┴────┬────────────┼──────┴─────┬───────────┴┬─────┴──────┬────────────╢"
  711. 15013 PRINT "║X-DATA ENTRY│PREDICTED Y │X-DATA ENTRY│PREDICTED Y │X-DATA ENTRY│PREDICTED Y ║"
  712. 15014 PRINT "╟────────────┼────────────┼────────────┼────────────┼────────────┼────────────╢"
  713. 15015 FOR I=1 TO 14:PRINT "║            │            │            │            │            │            ║":NEXT I
  714. 15029 PRINT "╟────────────┴───┬────────┴───────┬────┴───────────┬┴────────────┴──┬─────────╢"
  715. 15030 PRINT "║ Coefficients   │A=              │B=              │C=              │R²=      ║"
  716. 15031 PRINT "╚════════════════╧════════════════╧════════════════╧════════════════╧═════════╝";
  717. 15032 LOCATE 2,34:PRINT"▒▒▒▒▒▒";:LOCATE 2,34:INPUT;EQ:IF EQ=0 THEN EQ=MQ:LOCATE 2,34:PRINT MQ;:LOCATE 2,41:PRINT"BEST ";EQ$(MQ);:GOTO 15034
  718. 15033 LOCATE 2,34:PRINT"      ";:LOCATE 2,34:PRINT EQ;:IF EQ<0 OR EQ>25 THEN 15038 ELSE IF A(EQ)=0 AND B(EQ)=0 THEN 15043 ELSE LOCATE 2,41:PRINT "                           ";:LOCATE 2,41:PRINT EQ$(EQ);
  719. 15034 LOCATE 4,10:PRINT"▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";:LOCATE 4,35:PRINT"▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";:LOCATE 4,60:PRINT"▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";
  720. 15035 LOCATE 4,10:PRINT"                ";:LOCATE 4,10:INPUT;START:LOCATE 4,10:PRINT"               ";:LOCATE 4,10:PRINT START;
  721. 15036 LOCATE 4,35:PRINT"                ";:LOCATE 4,35:INPUT;STP1:LOCATE 4,35:PRINT"               ";:LOCATE 4,35:PRINT STP1;
  722. 15037 LOCATE 4,60:PRINT"                ";:LOCATE 4,60:INPUT;STP2:LOCATE 4,60:PRINT"               ";:LOCATE 4,60:PRINT STP2;:IF STP2<=0 THEN 15039 ELSE 15053
  723. 15038 IF EQ<0 OR EQ>25 THEN LOCATE 2,41:PRINT "EQUATION";EQ;" IS UNDEFINED ";:GOTO 15032
  724. 15039 LOCATE 2,41:PRINT"STEP MUST BE POSITIVE       ";:GOTO 15032
  725. 15043 LOCATE 2,41:PRINT" A AND B = ZERO FOR EQ ";EQ;:GOTO 15032
  726. 15053 IF LP=1 THEN LPRINT"PREDICTIONS FOR EQUATION ";EQ$(EQ):LPRINT" "
  727. 15054 LOCATE 23,21:V=A(EQ):GOSUB 4700:PRINT USING C2$;A(EQ);:LOCATE 23,38:V=B(EQ):GOSUB 4700:PRINT USING C2$;B(EQ);:LOCATE 23,55:V=C(EQ):GOSUB 4700:PRINT USING C2$;C(EQ);:LOCATE 23,73:PRINT USING"#.####";RC(EQ);
  728. 15060 K=0:ON EQ GOTO 15100,15110,15120,15130,15140,15150,15160,15170,15180,15190,15200,15210,15220,15230,15240,15250,15260,15270,15280,15290,15300,15310,15320,15330,15340,15350
  729. 15100 Y=A(1)+B(1)*START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15100
  730. 15110 Y=B(2)*START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15110
  731. 15120 Y=1/(A(3)+B(3)*START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15120
  732. 15130 Y=A(4)+B(4)*START+C(4)/START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15130
  733. 15140 Y=A(5)+B(5)/START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15140
  734. 15150 Y=START/(A(6)*START+B(6)):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15150
  735. 15160 Y=A(7)+B(7)/START+C(7)/(START*START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15160
  736. 15170 Y=A(8)+B(8)*START+C(8)*START*START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15170
  737. 15180 Y=A(9)*START+B(9)*START*START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15180
  738. 15190 Y=A(10)*START^B(10):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15190
  739. 15200 Y=A(11)*B(11)^START:GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15200
  740. 15210 Y=A(12)*B(12)^(1/START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15210
  741. 15220 Y=A(13)*START^(B(13)*START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15220
  742. 15230 Y=A(14)*START^(B(14)/START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15230
  743. 15240 Y=A(15)*EXP(B(15)*START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15240
  744. 15250 Y=A(16)*EXP(B(16)/START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15250
  745. 15260 Y=A(17)+B(17)*LOG(START):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15260
  746. 15270 Y=1/(A(18)+B(18)*LOG(START)):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15270
  747. 15280 Y=A(19)*B(19)^START*START^C(19):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15280
  748. 15290 Y=A(20)*B(20)^(1/START)*START^C(20):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15290
  749. 15300 Y=A(21)*EXP(((START-B(21))^2)/C(21)):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15300
  750. 15310 Y=A(22)*EXP((LOG(START)-B(22))^2/C(22)):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15310
  751. 15320 Y=A(23)*START^B(23)*(1-START)^C(23):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15320
  752. 15330 Y=A(24)*(START/B(24))^C(24)*EXP(START/B(24)):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15330
  753. 15340 Y=1/(A(25)*(START+B(25))^2+C(25)):GOSUB 15500:START=START+STP2:IF START>STP1 THEN 15003 ELSE 15340
  754. 15350 REM * END OF Y PREDICTIONS *
  755. 15500 IF INIT =1 THEN M=1:MR=1:MC=1:MR1=1:MC1=1
  756. 15502 L=1:INIT=0
  757. 15503 IF LEFT$(Q1A$,1)="Y" OR LEFT$(Q1A$,1)="y" THEN PRINT #1, START,Y
  758. 15505 IF LP=1 THEN LPRINT"If X= ";START,"Then Y= ";Y
  759. 15506 LOCATE 7+MR,MC+1:V=START:GOSUB 4700:PRINT USING C2$;START;:LOCATE 7+MR,MC+14:V=Y:GOSUB 4700:PRINT USING C2$;Y;
  760. 15507 MR=MR+1:IF M MOD 14=0 THEN MR=1:MC=MC+26
  761. 15508 IF M MOD 42 =0 THEN MR=1:MC=1:GOSUB 15600
  762. 15509 M=M+1
  763. 15511 IF LP=1 THEN 15515
  764. 15515 IF LP=1 AND (INT(M/60)=(M/60)) THEN LPRINT CHR$(12)
  765. 15520 RETURN
  766. 15600 LOCATE 25,1:PRINT"PLEASE PRESS <ENTER> FOR MORE DATA";:INPUT;A$:LOCATE 25,1:PRINT"                                                                       ";
  767. 15602 FOR I3 = 1 TO 42
  768. 15606 LOCATE 7+MR1,MC1+1:PRINT "            ";:LOCATE 7+MR1,MC1+14:PRINT "            ";
  769. 15607 MR1=MR1+1:IF I3 MOD 14=0 THEN MR1=1:MC1=MC1+26
  770. 15608 IF I3 MOD 42 =0 THEN MR1=1:MC1=1
  771. 15610 NEXT I3
  772. 15620 RETURN
  773. 20000 REM * CALCULATE SUMS AND SUMS OF SQUARES *
  774. 20010 NX=0:NY=0
  775. 20040 FOR I=16 TO 65: R(I)=0: NEXT I
  776. 20041 Q9=0:QA=1:GOTO 3430
  777. 20045 FOR I=1 TO 999
  778. 20046 CLS:GOSUB 38000:PRINT"PROCESSING DATA POINT # "; I
  779. 20047 IF X$(1)="END" OR Y$(1)="END" THEN PRINT "NO DATA HAS BEEN ENTERED":PRINT"RETURNING TO MAIN MENU":FOR I1=1 TO 1000:NEXT I1:GOTO 120
  780. 20055 IF X$(I)= "END" OR Y$(I)="END" OR X$(I)="DEL" OR Y$(I)="DEL" GOTO 30000
  781. 20060 X(I)=CDBL(VAL(X$(I))):Y(I)=CDBL(VAL(Y$(I)))
  782. 20065 IF X(I)<0 THEN NX=1
  783. 20066 IF Y(I)<0 THEN NY=1
  784. 20067 IF X(I)=0 THEN X(I)=.0001
  785. 20068 IF Y(I)=0 THEN Y(I)=.0001
  786. 20070 R(16)=R(16)+X(I)
  787. 20080 R(17)=R(17)+X(I)*X(I)
  788. 20090 R(18)=R(18)+Y(I)
  789. 20100 R(19)=R(19)+Y(I)*Y(I)
  790. 20110 R(20)=R(20)+X(I)*Y(I)
  791. 20120 R(21)=I
  792. 20130 R(22)=R(22)+(1/X(I))
  793. 20140 R(23)=R(23)+(1/(X(I)*X(I)))
  794. 20150 R(24)=R(24)+(1/(Y(I)))
  795. 20160 R(25)=R(25)+(1/(Y(I)*Y(I)))
  796. 20170 R(26)=R(26)+(1/(Y(I)*X(I)))
  797. 20180 R(27)=I
  798. 20190 IF NX<>1 THEN R(28)=R(28)+LOG(X(I))
  799. 20200 IF NX<>1 THEN R(29)=R(29)+(LOG(X(I)))*(LOG(X(I)))
  800. 20210 IF NY <>1 THEN R(30)=R(30)+(LOG(Y(I)))
  801. 20220 IF NY<>1 THEN R(31)=R(31)+(LOG(Y(I)))*(LOG(Y(I)))
  802. 20230 IF NX<>1 AND NY<>1 THEN R(32)=R(32)+(LOG(X(I)))*(LOG(Y(I)))
  803. 20240 R(33)=I
  804. 20250 R(34)=R(34)+(X(I)/Y(I))
  805. 20260 R(35)=R(35)+(Y(I)/X(I))
  806. 20270 R(36)=R(36)+((X(I)*X(I)))*Y(I)
  807. 20280 R(37)=R(37)+((X(I)*X(I)))/Y(I)
  808. 20290 R(38)=R(38)+(Y(I)/(X(I)*X(I)))
  809. 20300 R(39)=R(39)+X(I)*(Y(I)*Y(I))
  810. 20310 R(40)=R(40)+(X(I)*X(I)*X(I))
  811. 20320 R(41)=R(41)+1/((X(I)*X(I)*X(I)))
  812. 20330 R(42)=R(42)+(Y(I)*Y(I)*Y(I))
  813. 20340 R(43)=R(43)+(X(I)*X(I)*X(I)*X(I))
  814. 20350 R(44)=R(44)+1/((X(I)*X(I)*X(I)*X(I)))
  815. 20360 IF NX<>1 THEN R(45)=R(45)+LOG(X(I))/X(I)
  816. 20370 IF NY<>1 THEN R(46)=R(46)+X(I)*LOG(Y(I))
  817. 20380 IF NY<>1 THEN R(47)=R(47)+LOG(Y(I))/X(I)
  818. 20390 IF NX<>1 THEN R(48)=R(48)+X(I)*LOG(X(I))
  819. 20400 IF NX<>1 THEN R(49)=R(49)+(X(I)*LOG(X(I)))*(X(I)*LOG(X(I)))
  820. 20410 IF NX<>1 AND NY<>1 THEN R(50)=R(50)+X(I)*LOG(X(I))*LOG(Y(I))
  821. 20420 IF NX<>1 THEN R(51)=R(51)+Y(I)*LOG(X(I))
  822. 20430 IF NX<>1 THEN R(52)=R(52)+LOG(X(I))/Y(I)
  823. 20440 IF NX<>1 THEN R(53)=R(53)+((LOG(X(I))/X(I)))*((LOG(X(I))/X(I)))
  824. 20450 IF NY<>1 THEN R(54)=R(54)+(X(I)*X(I))*LOG(Y(I))
  825. 20460 IF NX<>1 THEN R(55)=R(55)+((LOG(X(I))*LOG(X(I))*LOG(X(I))))
  826. 20470 IF NX<>1 THEN R(56)=R(56)+((LOG(X(I))*LOG(X(I))*LOG(X(I))*LOG(X(I))))
  827. 20480 IF NX<>1 AND NY<>1 THEN R(57)=R(57)+((LOG(X(I))*LOG(X(I))))*LOG(Y(I))
  828. 20490 IF NX<>1 AND NY<>1 THEN R(58)=R(58)+(LOG(Y(I))*LOG(X(I)))/X(I)
  829. 20500 IF X(I)>=1 THEN Q9=1: GOTO 20540
  830. 20501 IF Q9=1 GOTO 20540
  831. 20502 IF X(I)<=0 THEN 20550
  832. 20505 R(59)=R(59)+LOG(1-X(I))
  833. 20510 R(60)=R(60)+(LOG(1-X(I)))*(LOG(1-X(I)))
  834. 20520 R(61)=R(61)+LOG(X(I))*LOG(1-X(I))
  835. 20530 IF NY<>1 THEN R(62)=R(62)+LOG(Y(I))*LOG(1-X(I))
  836. 20540 IF NX<>1 THEN R(63)=R(63)+(LOG(X(I)))/X(I)
  837. 20550 NEXT I
  838. 20600 NX=0:NY=0
  839. 30000 REM * END OF SUMMATION LOOP *
  840. 30030 CLS:GOSUB 38000: PRINT"SUMS HAVE BEEN CALCULATED--NOW CALCULATING COEFFICIENTS": GOTO 12000
  841. 36000 CLS:REM This routine selects Color or Monochrome Monitor
  842. 36005 PRINT TAB(20);"CURVEFIT Version 2.25a MAY 09, 1992":PRINT" "
  843. 36010 PRINT"This routine allows the selection of Color or Monochrome monitors."
  844. 36020 PRINT" ":PRINT"For most cases, the COLOR choice will be correct.  This choice will work with"
  845. 36030 PRINT"CGA, EGA, and Hercules compatible cards.  Select the MONOCHROME version"
  846. 36040 PRINT"only if the COLOR choice does not work."
  847. 36045 PRINT" ":PRINT"MONOCHROME should work with ANY monitor.  With a color monitor, the"
  848. 36046 PRINT"choice of MONOCHROME will yield white text on a black background.":PRINT" "
  849. 36047 PRINT" ":PRINT"When COLOR choice is used for MONOCHROME monitor, display is HIGH INTENSITY."
  850. 36048 PRINT" ":PRINT"To use low intensity on MONOCHROME monitor, choose MONOCHROME monitor."
  851. 36050 PRINT" ":PRINT "Please press <C> or <ENTER> for COLOR.  Press <M> for MONOCHROME.  "
  852. 36060 PRINT" ":MONITOR$="C"
  853. 36061 MONITOR1$=INKEY$:IF MONITOR1$="m" OR MONITOR1$="M" OR MONITOR1$="C" OR MONITOR1$="c" OR MONITOR1$=CHR$(13) THEN 36110 ELSE 36061
  854. 36110 IF MONITOR1$="C" OR MONITOR1$="c" OR MONITOR1$=CHR$(13) THEN PRINT"You have chosen COLOR monitor":PRINT" ":MONITOR$="C":INPUT"Press <Enter> to Continue";CT$:IF MONITOR2$="Y" THEN MONITOR2$="N":GOTO 10
  855. 36115 IF MONITOR1$="C" OR MONITOR1$="C" OR MONITOR1$=CHR$(13) THEN 115
  856. 36120 IF MONITOR1$="M" OR MONITOR1$="m" THEN PRINT"You have chosen MONOCHROME monitor":PRINT" ":MONITOR$="M":INPUT"Press <Enter> to Continue";CT$:IF MONITOR2$="Y" THEN MONITOR2$="N":GOTO 10
  857. 36125 IF MONITOR1$="M" OR MONITOR1$="m" THEN 115
  858. 36130 GOTO 36010
  859. 38000 IF MONITOR$="M" THEN 38100
  860. 38010 COLOR 15,1,0:RETURN
  861. 38100 COLOR 7,0,0:RETURN
  862. 40000 REM * LIST REGISTER CONTENTS R16-R63 *
  863. 40010 CLS
  864. 40025 CLS:GOSUB 38000:PRINT"REGISTER CONTENTS:":PRINT" ":PRINT"REG#";TAB(10);"REGISTER";TAB(34);"REGISTER +1";TAB(57);"REGISTER +2":PRINT" ":FOR I=16 TO 63 STEP 3
  865. 40095 PRINT I;TAB(6);R(I);TAB(29);R(I+1);TAB(54);R(I+2)
  866. 40100 NEXT I
  867. 40105 PRINT" "
  868. 40120 INPUT "PLEASE PRESS ENTER TO CONTINUE ";A$
  869. 40122 INPUT"OUTPUT TO PRINTER (Y)ES OR (N)O ";A$
  870. 40124 IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN 40126 ELSE GOTO 120
  871. 40126 FOR I=16 TO 63 STEP 2
  872. 40127 LPRINT "R(";I;")= ";R(I);TAB(40);"R(";I+1;")= ";R(I+1)
  873. 40128 NEXT I
  874. 40129 LPRINT CHR$(12):GOTO 120
  875. 42000 CLS:GOSUB 38000:IF A(1)=0 AND B(1)=0 THEN PRINT"COEFFICIENTS MUST BE CALCULATED BEFORE USING THIS ROUTINE!":PRINT" ":INPUT"PLEASE PRESS <ENTER> TO RETURN TO MAIN MENU";RMM$:GOTO 120
  876. 42010 FOR I=1 TO 25:RS$(I)=STR$(RC(I))+"_"+STR$(I):NEXT I
  877. 42015 REM SHELL-METZNER SORT
  878. 42020 MX=25
  879. 42025 M1=MX
  880. 42030 M1=M1\2:IF M1=0 THEN 43000
  881. 42040 K1=MX-M1:J1=1
  882. 42050 I1=J1
  883. 42060 L1=I1+M1
  884. 42070 IF RS$(I1)<=RS$(L1) THEN J1=J1+1:IF J1>K1 THEN 42030 ELSE 42050
  885. 42080 SWAP RS$(I1),RS$(L1):I1=I1-M1:IF I1>0 THEN 42060
  886. 42090 J1=J1+1:IF J1>K1 THEN 42030 ELSE 42050
  887. 43000 '
  888. 43310 '
  889. 43320 K2=25:FOR I=1 TO 25:RS1$(I)=RS$(K2):K2=K2-1:NEXT I
  890. 43330 FOR I=1 TO 25:RS$(I)=RS1$(I):NEXT I
  891. 43340 FOR I=1 TO 25:P1=INSTR(RS$(I),"_"):RS(I)=VAL(MID$(RS$(I),P1+2,LEN(RS$(I)))):NEXT I
  892. 43350 REM WAS GOSUB 38000
  893. 43507 PRINT "╔═══════════╦═══════════════════════════════════════════════════╦═════════════╗"
  894. 43508 PRINT "║ CURVEFIT  ║ SORTED LISTING OF EQUATIONS for CORRECTED R² >0.10║VERSION 2.25a║"
  895. 43509 PRINT "╠════╤══════╩═════╤════════════╤════════════╤══════╤══════╤═════╩═════════════╣"
  896. 43510 PRINT "║EQ #│ 'A' COEF.  │ 'B' COEF.  │ 'C' COEF.  │ R²   │R² COR│ EQUATION OF CURVE ║"
  897. 43511 PRINT "╟────┼────────────┼────────────┼────────────┼──────┼──────┼───────────────────╢"
  898. 43512 FOR I=1 TO 18:PRINT "║    │            │            │            │      │      │                   ║":NEXT I
  899. 43517 PRINT "╚════╧════════════╧════════════╧════════════╧══════╧══════╧═══════════════════╝";
  900. 43518 C1$="#.####":C2$="#######.####":C3$="###"
  901. 43524 MR=6:
  902. 43526 FOR I=1 TO 25
  903. 43527 IF RC(RS(I))<=.1 THEN 43531
  904. 43528 LOCATE MR,2:PRINT USING C3$;RS(I);:LOCATE MR,7:V=A(RS(I)):GOSUB 4700:PRINT USING C2$;A(RS(I)):LOCATE MR,20:V=B(RS(I)):GOSUB 4700:PRINT USING C2$;B(RS(I));:LOCATE MR,33:V=C(RS(I)):GOSUB 4700:PRINT USING C2$;C(RS(I));
  905. 43529 LOCATE MR,46:PRINT USING C1$;RR(RS(I));:LOCATE MR,53:PRINT USING C1$;RC(RS(I));:LOCATE MR,60:PRINT EQ$(RS(I));
  906. 43530 MR=MR+1:IF MR=24 THEN 43532
  907. 43531 NEXT I
  908. 43532 LOCATE 25,1:INPUT"PLEASE PRESS <ENTER> TO RETURN TO MAIN MENU";RMM$:GOTO 120
  909. 50000 IF LEFT$(Q1$,1)="Y" OR LEFT$(Q1$,1)="y" THEN LP=1 ELSE LP=0
  910. 50010 RETURN
  911. 55000 EQ$(1)="Y=A+B*X":EQ$(2)="Y=B*X":EQ$(3)="Y=1/(A+B*X)":EQ$(4)="Y=A+B*X+C/X":EQ$(5)="Y=A+B/X":EQ$(6)="Y=X/(A*X+B)"
  912. 55010 EQ$(7)="Y=A+B/X+C/X*X":EQ$(8)="Y=A+B*X+C*X*X":EQ$(9)="Y=A*X+B*X*X":EQ$(10)="Y=A*X^B":EQ$(11)="Y=A*B^X"
  913. 55020 EQ$(12)="Y=A*B^(1/X)":EQ$(13)="Y=A*X^(B*X)":EQ$(14)="Y=A*X^(B/X)":EQ$(15)="Y=A*e^(B*X)":EQ$(16)="Y=A*e^(B/X)"
  914. 55030 EQ$(17)="Y=A+B*lnX":EQ$(18)="Y=1/(A+B*lnX)":EQ$(19)="Y=A*B^X*X^C":EQ$(20)="Y=A*B^(1/X)*X^C"
  915. 55040 EQ$(21)="Y=A*e^(((X-B)^2)/C)":EQ$(22)="Y=A*e^((lnX-B)^2/C)":EQ$(23)="Y=A*X^B*(1-X)^C":EQ$(24)="Y=A*(X/B)^C*e^(x/b)"
  916. 55050 EQ$(25)="Y=1/(A*(X+B)^2+C)":RETURN
  917. 57000 CLS:PRINT"You have chosen to store Residual Values to a Disk File"
  918. 57010 PRINT:INPUT "Enter File Name for Data Storage (Include Drive Designator) ",PF$
  919. 57020 PRINT:PRINT"File Name for Residual Data Storage is ";PF$
  920. 57030 PRINT:INPUT"Is this correct (Y) or (N): (A) to Abort";PF1$
  921. 57040 IF LEFT$(PF1$,1)="Y" OR LEFT$(PF1$,1) = "y" THEN GOTO 57050 ELSE IF LEFT$(PF1$,1)="A" OR LEFT$(PF1$,1)="a" THEN GOTO 120 ELSE GOTO 57000
  922. 57050 OPEN "O",1,PF$:GOTO 5007
  923. 57200 CLS:GOTO 5007
  924. 58000 CLS:PRINT"You have chosen to store PREDICTED Values to a Disk File"
  925. 58010 PRINT:INPUT "Enter File Name for Data Storage (Include Drive Designator) ",PF$
  926. 58020 PRINT:PRINT"File Name for Residual Data Storage is ";PF$
  927. 58030 PRINT:INPUT"Is this correct (Y) or (N): (A) to Abort";PF1$
  928. 58040 IF LEFT$(PF1$,1)="Y" OR LEFT$(PF1$,1) = "y" THEN GOTO 58050 ELSE IF LEFT$(PF1$,1)="A" OR LEFT$(PF1$,1)="a" THEN GOTO 120 ELSE GOTO 58000
  929. 58050 OPEN "O",1,PF$:GOTO 15007
  930. 58200 CLS:GOTO 15007
  931. $SEGMENT
  932. 61000 IF (ERR=53 OR ERR=64) AND ERL=7050 THEN PRINT "UNABLE TO FIND OR ILLEGAL FILE NAME ";A4$:INPUT "PRESS <ENTER> TO CONTINUE";A$:RESUME 120
  933. 62101 GOSUB 62150:RESUME 12060
  934. 62102 GOSUB 62150:RESUME 12140
  935. 62103 GOSUB 62150:RESUME 12220
  936. 62104 GOSUB 62150:RESUME 12320
  937. 62105 GOSUB 62150:RESUME 12400
  938. 62106 GOSUB 62150:RESUME 12470
  939. 62107 GOSUB 62150:RESUME 12590
  940. 62108 GOSUB 62150:RESUME 12720
  941. 62109 GOSUB 62150:RESUME 12810
  942. 62110 GOSUB 62150:RESUME 13000
  943. 62111 GOSUB 62150:RESUME 13110
  944. 62112 GOSUB 62150:RESUME 13210
  945. 62113 GOSUB 62150:RESUME 13300
  946. 62114 GOSUB 62150:RESUME 13400
  947. 62115 GOSUB 62150:RESUME 13500
  948. 62116 GOSUB 62150:RESUME 13600
  949. 62117 GOSUB 62150:RESUME 13680
  950. 62118 GOSUB 62150:RESUME 14000
  951. 62119 GOSUB 62150:RESUME 14150
  952. 62120 GOSUB 62150:RESUME 14300
  953. 62121 GOSUB 62150:RESUME 14460
  954. 62122 GOSUB 62150:RESUME 14620
  955. 62123 GOSUB 62150:RESUME 14760
  956. 62124 GOSUB 62150:RESUME 14920
  957. 62125 GOSUB 62150:RESUME 14954
  958. 62150 REM This subroutine zeroes out all coefficients for equations with errors
  959. 62160 A(I)=0:B(I)=0:C(I)=0:RR(I)=0:RC(I)=0:RETURN
  960. 63000 IF ERR=64 AND ERL=6050 THEN PRINT" THE FILE NAME ";A4$;" IS NOT A VALID FILE NAME":INPUT"PRESS <ENTER> TO CONTINUE";A$:RESUME 120
  961. 63500 IF D1>21 THEN D1=8 ELSE IF D1<8 THEN D1=21
  962. 63505 FLAG=0:LOCATE D1,11,1,0,7
  963. 63510 D1=CSRLIN
  964. 63520 A$=INKEY$:IF A$=CHR$(13) THEN 63560 ELSE IF A$="8" THEN D1=D1-1:GOTO 63500
  965. 63521 IF A$=CHR$(27) THEN 8000 ELSE IF A$="2" THEN D1=D1+1:GOTO 63500
  966. 63523 IF LEN(A$)=2 THEN A$=RIGHT$(A$,1) ELSE GOTO 63500
  967. 63525 IF A$="H" THEN D1=D1-1:GOTO 63500
  968. 63526 IF A$="P" THEN D1=D1+1:GOTO 63500
  969. 63527 IF A$>=";" AND A$<="D" THEN FLAG=1: GOTO 63560
  970. 63528 IF A$>="T" AND A$<="W" THEN FLAG=1: GOTO 63560
  971. 63529 GOTO 63500
  972. 63530 D1=D1+1:GOTO 63500
  973. 63560 D1=CSRLIN
  974. 63564 IF FLAG=1 THEN 63675
  975. 63565 IF CSRLIN=8 THEN 110
  976. 63570 IF CSRLIN=9 THEN 7030
  977. 63580 IF CSRLIN=10 THEN 2000
  978. 63590 IF CSRLIN=11 THEN 3000
  979. 63600 IF CSRLIN=12 THEN 9005
  980. 63610 IF CSRLIN=13 THEN 4000
  981. 63620 IF CSRLIN=14 THEN 4990
  982. 63630 IF CSRLIN=15 THEN 10000
  983. 63640 IF CSRLIN=16 THEN 4040
  984. 63645 IF CSRLIN=17 THEN 15002
  985. 63650 IF CSRLIN=18 THEN 6030
  986. 63655 IF CSRLIN=19 THEN 40000
  987. 63660 IF CSRLIN=20 THEN 42000
  988. 63665 IF CSRLIN=21 THEN 36000
  989. 63670 GOTO 63500
  990. 63675 IF A$=";"  THEN 110
  991. 63676 IF A$="<" THEN  7030
  992. 63677 IF A$="=" THEN 2000
  993. 63678 IF A$=">" THEN 3000
  994. 63679 IF A$="?" THEN 9005
  995. 63680 IF A$="@" THEN 4000
  996. 63681 IF A$="A" THEN 4990
  997. 63682 IF A$="B" THEN 10000
  998. 63683 IF A$="C" THEN 4040
  999. 63684 IF A$="D" THEN 15002
  1000. 63685 IF A$="T" THEN 6030
  1001. 63686 IF A$="U" THEN 40000
  1002. 63687 IF A$="V" THEN 42000
  1003. 63688 IF A$="W" THEN 36000
  1004. 63690 GOTO 63500
  1005. 63700 CLS:GOSUB 38000:PRINT"DATA CORRECTION":PRINT" "
  1006. 63711 CLS:GOSUB 38000:M=1:MR=1:MC=1:MR1=1:MC1=1
  1007. 63712 PRINT "╔═══════════╤══════════════════════════════════════════════════════╤══════════╗"
  1008. 63713 PRINT "║ CURVEFIT  │ DATA LIST OF X AND Y VALUES  NOW IN MEMORY           │VERS 2.25a║"
  1009. 63716 PRINT "╟───┬───────┴──┬──────────┬───┬──────────┬──────────┬───┬──────────┼──────────╢"
  1010. 63717 PRINT "║PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  │PT#│ X VALUE  │ Y VALUE  ║"
  1011. 63718 PRINT "╟───┼──────────┼──────────┼───┼──────────┼──────────┼───┼──────────┼──────────╢"
  1012. 63719 FOR I6=1 TO 18:PRINT "║   │          │          │   │          │          │   │          │          ║"
  1013. 63720 NEXT I6
  1014. 63735 PRINT "╚═══╧══════════╧══════════╧═══╧══════════╧══════════╧═══╧══════════╧══════════╝";
  1015. 63736 DUMMY$="          ":QZ=1:GOSUB 3470:QZ=0:FOR J=1 TO 999
  1016. 63737 IF X$(J)<>"END" OR Y$(J)<>"END" THEN 63746 ELSE 63800
  1017. 63746 LOCATE 5+MR,MC+1:PRINT USING "###";M;
  1018. 63748 LOCATE 5+MR,MC+5:V=VAL(X$(M)):GOSUB 4710
  1019. 63749 PRINT USING C2$;V;
  1020. 63750 LOCATE 5+MR,MC+16:V=VAL(Y$(M)):GOSUB 4710
  1021. 63751 PRINT USING C2$;V;
  1022. 63752 MR=MR+1
  1023. 63753 IF M MOD 18=0 THEN MR=1:MC=MC+26
  1024. 63754 IF M MOD 54=0 THEN MR=1:MC=1:GOTO 63800
  1025. 63777 M=M+1
  1026. 63780 NEXT J
  1027. 63800 LOCATE 25,1:PRINT "<ESC> TO MENU OR <ENTER> TO CONTINUE";:A$=INKEY$
  1028. 63801 IF A$=CHR$(27) THEN 120 ELSE IF A$=CHR$(13) THEN 63802 ELSE 63800
  1029. 63802 IF M<999 AND X$(J)<>"END" THEN 63900 ELSE GOTO 9008
  1030. 63900 DUMMY$="            ":FOR J9=1 TO 54: REM This routine blanks screen for DATA LIST
  1031. 63910 LOCATE 5+MR1,MC1+1:PRINT LEFT$(DUMMY$,3);:LOCATE 5+MR1,MC1+5:PRINT LEFT$(DUMMY$,10);:LOCATE 5+MR1,MC1+16:PRINT LEFT$(DUMMY$,10);
  1032. 63920 MR1=MR1+1:IF J9 MOD 18=0 THEN MR1=1:MC1=MC1+26
  1033. 63930 IF J9 MOD 54=0 THEN MR1=1:MC1=1
  1034. 63940 NEXT J9
  1035. 63950 GOTO 63777
  1036. 64000 DUMMY$="            ":MR1=1:MC1=1: REM This routine blanks screen for ADD and DELETION routines
  1037. 64001 LOCATE 25,1,0,1,7:COLOR 0,7,0:PRINT "<ESC> TO GO TO MAIN MENU; <ENTER> FOR MORE DATA";:A$=INKEY$
  1038. 64002 IF A$=CHR$(27) THEN 120 ELSE IF A$=CHR$(13) THEN 64003 ELSE 64001
  1039. 64003 LOCATE 25,1,0,1,7:GOSUB 38000:PRINT"                                                                               ";
  1040. 64005 FOR J9=1 TO 42
  1041. 64010 LOCATE 7+MR1,MC1+1:PRINT LEFT$(DUMMY$,3);:LOCATE 7+MR1,MC1+5:PRINT LEFT$(DUMMY$,10);:LOCATE 7+MR1,MC1+16:PRINT LEFT$(DUMMY$,10);
  1042. 64020 MR1=MR1+1:IF J9 MOD 14 = 0 THEN MR1 =1:MC1=MC1+26
  1043. 64030 IF J9 MOD 42 = 0 THEN MR1=1:MC1=1
  1044. 64035 NEXT J9
  1045. 64040 RETURN
  1046.  
  1047.